home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / menu.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  73.6 KB  |  2,380 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test menus in Tk.  It is
  2. # organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1995-1997 Sun Microsystems, Inc.
  5. #
  6. # See the file "license.terms" for information on usage and redistribution
  7. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  8. #
  9. # SCCS: @(#) menu.test 1.42 97/08/08 17:27:51
  10.  
  11. if {[lsearch [image types] test] < 0} {
  12.     puts "This application hasn't been compiled with the \"test\" image"
  13.     puts "type, so I can't run this test.  Are you sure you're using"
  14.     puts "tktest instead of wish?"
  15.     return
  16. }
  17.  
  18. if {[info procs test] != "test"} {
  19.     source defs
  20. }
  21.  
  22. if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} {
  23.     puts " Some tests were skipped because they could not be performed"
  24.     puts " automatically on this platform. If you wish to execute them"
  25.     puts " interactively, set the TCL variable INTERACTIVE and re-run"
  26.     puts " the test."
  27.     set testConfig(menuInteractive) 0
  28. } else {
  29.     set testConfig(menuInteractive) 1
  30. }
  31.  
  32. proc deleteWindows {} {
  33.     foreach i [winfo children .] {
  34.         catch [destroy $i]
  35.     }
  36. }
  37.  
  38. deleteWindows
  39. wm geometry . {}
  40. raise .
  41.  
  42. test menu-1.1 {Tk_MenuCmd procedure} {
  43.     list [catch menu msg] $msg
  44. } {1 {wrong # args: should be "menu pathName ?options?"}}
  45. test menu-1.2 {Tk_MenuCmd procedure} {
  46.     list [catch "menu bogus" msg] $msg
  47. } {1 {bad window path name "bogus"}}
  48. test menu-1.3 {Tk_MenuCmd procedure} {
  49.     list [catch "menu .m1 foo" msg] $msg
  50. } {1 {unknown option "foo"}}
  51. test menu-1.4 {Tk_MenuCmd procedure} {
  52.     catch {destroy .m1}
  53.     list [catch {menu .m1} msg] $msg [destroy .m1]
  54. } {0 .m1 {}}
  55. test menu-1.5 {Tk_MenuCmd - creating menubar} {
  56.     catch {destroy .m1}
  57.     menu .m1
  58.     .m1 add cascade -label Test -menu ""
  59.     list [. configure -menu .m1] [. configure -menu ""] [destroy .m1]
  60. } {{} {} {}}
  61. test menu-1.6 {Tk_MenuCmd procedure menu ref no cascade} {
  62.     catch {destroy .t2}
  63.     catch {destroy .m1}
  64.     toplevel .t2 -menu .m1
  65.     wm geometry .t2 +0+0
  66.     list [catch {menu .m1} msg] $msg [destroy .m1 .t2]
  67. } {0 .m1 {}}
  68. test menu-1.7 {Tk_MenuCmd procedure one clone cascade} {
  69.     catch {destroy .m1}
  70.     catch {destroy .m2}
  71.     catch {destroy .t2}
  72.     toplevel .t2 -menu .m1
  73.     wm geometry .t2 +0+0
  74.     menu .m1
  75.     .m1 add cascade -menu .m2
  76.     list [catch {menu .m2} msg] $msg [destroy .t2 .m1 .m2]
  77. } {0 .m2 {}}
  78. test menu-1.8 {Tk_MenuCmd procedure two clone cascades} {
  79.     catch {destroy .m1}
  80.     catch {destroy .t2}
  81.     catch {destroy .t3}
  82.     catch {destroy .m2}
  83.     menu .m1
  84.     .m1 add cascade -menu .m2
  85.     toplevel .t2 -menu .m1
  86.     wm geometry .t2 +0+0
  87.     toplevel .t3 -menu .m1
  88.     wm geometry .t3 +0+0
  89.     list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
  90. } {0 .m2 {}}
  91. test menu-1.9 {Tk_MenuCmd procedure two clone cascades different order} {
  92.     catch {destroy .t2}
  93.     catch {destroy .m1}
  94.     catch {destroy .t3}
  95.     catch {destroy .m2}
  96.     toplevel .t2 -menu .m1
  97.     wm geometry .t2 +0+0
  98.     menu .m1
  99.     .m1 add cascade -menu .m2
  100.     toplevel .t3 -menu .m1
  101.     wm geometry .t3 +0+0
  102.     list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
  103. } {0 .m2 {}}
  104. test menu-1.10 {Tk_MenuCmd procedure two clone cascades menus last} {
  105.     catch {destroy .t2}
  106.     catch {destroy .t3}
  107.     catch {destroy .m1}
  108.     catch {destroy .m2}
  109.     toplevel .t2 -menu .m1
  110.     wm geometry .t2 +0+0
  111.     toplevel .t3 -menu .m1
  112.     wm geometry .t3 +0+0
  113.     menu .m1
  114.     .m1 add cascade -menu .m2
  115.     list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
  116. } {0 .m2 {}}
  117. test menu-1.11 {Tk_MenuCmd procedure three clones cascades} {
  118.     catch {destroy .t2}
  119.     catch {destroy .t3}
  120.     catch {destroy .t4}
  121.     catch {destroy .m1}
  122.     catch {destroy .m2}
  123.     toplevel .t2 -menu .m1
  124.     wm geometry .t2 +0+0
  125.     toplevel .t3 -menu .m1
  126.     wm geometry .t3 +0+0
  127.     toplevel .t4 -menu .m1
  128.     wm geometry .t4 +0+0
  129.     menu .m1
  130.     .m1 add cascade -menu .m2
  131.     list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .t4 .m1 .m2]
  132. } {0 .m2 {}}
  133. test menu-1.12 {Tk_MenuCmd procedure} {
  134.     catch {destroy .t2}
  135.     catch {destroy .m1}
  136.     toplevel .t2 -menu .m1
  137.     wm geometry .t2 +0+0
  138.     list [catch {menu .m1} msg] $msg [destroy .t2 .m1]
  139. } {0 .m1 {}}
  140. test menu-1.13 {Tk_MenuCmd procedure} {
  141.     catch {destroy .t2}
  142.     catch {destroy .t3}
  143.     catch {destroy .m1}
  144.     toplevel .t2 -menu .m1
  145.     wm geometry .t2 +0+0
  146.     toplevel .t3 -menu .m1
  147.     wm geometry .t3 +0+0
  148.     list [catch {menu .m1} msg] $msg [destroy .t2 .t3 .m1]
  149. } {0 .m1 {}}
  150. test menu-1.14 {Tk_MenuCmd procedure} {
  151.     catch {destroy .t2}
  152.     catch {destroy .t3}
  153.     catch {destroy .t4}
  154.     catch {destroy .m1}
  155.     toplevel .t2 -menu .m1
  156.     wm geometry .t2 +0+0
  157.     toplevel .t3 -menu .m1
  158.     wm geometry .t3 +0+0
  159.     toplevel .t4 -menu .m1
  160.     wm geometry .t4 +0+0
  161.     list [catch {menu .m1} msg] $msg [destroy .t2 .t3 .t4 .m1]
  162. } {0 .m1 {}}
  163.  
  164. catch {destroy .m1}
  165. menu .m1
  166. set i 1
  167. foreach test {
  168.     {-activebackground #012345 #012345 non-existent
  169.         {unknown color name "non-existent"}}
  170.     {-activeborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  171.     {-activeforeground #ff0000 #ff0000 non-existent
  172.         {unknown color name "non-existent"}}
  173.     {-background #ff0000 #ff0000 non-existent
  174.         {unknown color name "non-existent"}}
  175.     {-bg #110022 #110022 bogus {unknown color name "bogus"}}
  176.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  177.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  178.     {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
  179.     {-fg #110022 #110022 bogus {unknown color name "bogus"}}
  180.     {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
  181.         -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {}
  182.         {font "" doesn't exist}}
  183.     {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
  184.     {-postcommand "any old string" "any old string" {} {}}
  185.     {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
  186.     {-selectcolor #110022 #110022 bogus {unknown color name "bogus"}}
  187.     {-takefocus "any string" "any string" {} {}}
  188.     {-tearoff 0 0}
  189.     {-tearoff 1 1}
  190.     {-tearoffcommand "any old string" "any old string" {} {}}
  191. } {
  192.     set name [lindex $test 0]
  193.     test menu-2.$i {configuration options} {
  194.     .m1 configure $name [lindex $test 1]
  195.     lindex [.m1 configure $name] 4
  196.     } [lindex $test 2]
  197.     incr i
  198.     if {[lindex $test 3] != ""} {
  199.     test menu-2.$i {configuration options} {
  200.         list [catch {.m1 configure $name [lindex $test 3]} msg] $msg
  201.     } [list 1 [lindex $test 4]]
  202.     }
  203.     .m1 configure $name [lindex [.m1 configure $name] 3]
  204.     incr i
  205. }
  206. destroy .m1
  207.  
  208. # We need to test all of the options with all of the different types of
  209. # menu entries. The following code sets up .m1 with 6 items. It then
  210. # runs through the big table below it.
  211. # index 0 is tearoff, 1 command, 2 cascade, 3 separator, 4 checkbutton, 
  212. # 5 radiobutton
  213.  
  214. menu .m1
  215. .m1 add command -label "command"
  216. menu .m2
  217. .m2 add command -label "test"
  218. .m1 add cascade -label "cascade" -menu .m2
  219. .m1 add separator
  220. .m1 add checkbutton -label "checkbutton" -variable check -onvalue on -offvalue off
  221. .m1 add radiobutton -label "radiobutton" -variable radio
  222. image create photo image1 -file [file join $tk_library demos images earth.gif]
  223.  
  224. foreach test {
  225.     {-activebackground 
  226.         {{#012345 
  227.             {{unknown option "-activebackground"} #012345 #012345 
  228.             {unknown option "-activebackground"} #012345 #012345
  229.             }
  230.         }
  231.         {non-existent 
  232.             {{unknown option "-activebackground"} 
  233.         {unknown color name "non-existent"}
  234.         {unknown color name "non-existent"}
  235.         {unknown option "-activebackground"}
  236.         {unknown color name "non-existent"}
  237.         {unknown color name "non-existent"}
  238.         }
  239.     }}
  240.     }
  241.     {-activeforeground
  242.         {{#ff0000 
  243.             {{unknown option "-activeforeground"}
  244.         #ff0000 #ff0000 {unknown option "-activeforeground"} #ff0000 #ff0000
  245.         }
  246.     }
  247.     {non-existent
  248.         {{unknown option "-activeforeground"} 
  249.         {unknown color name "non-existent"}
  250.         {unknown color name "non-existent"}
  251.         {unknown option "-activeforeground"}
  252.         {unknown color name "non-existent"}
  253.         {unknown color name "non-existent"}
  254.         }
  255.     }}
  256.     }
  257.     {-accelerator
  258.         {{"Ctrl+S" 
  259.             {{unknown option "-accelerator"}
  260.         "Ctrl+S" "Ctrl+S" {unknown option "-accelerator"} 
  261.         "Ctrl+S" "Ctrl+S"
  262.         }
  263.     }}
  264.     }
  265.     {-background
  266.         {{#ff0000 
  267.             {#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000
  268.         }
  269.     }
  270.     {non-existent
  271.         {{unknown color name "non-existent"} 
  272.         {unknown color name "non-existent"}
  273.         {unknown color name "non-existent"}
  274.         {unknown color name "non-existent"}
  275.         {unknown color name "non-existent"}
  276.         {unknown color name "non-existent"}
  277.         }
  278.     }}
  279.     }
  280.     {-bitmap
  281.         {{questhead 
  282.             {{unknown option "-bitmap"} questhead questhead 
  283.             {unknown option "-bitmap"} questhead questhead
  284.         }
  285.     }
  286.     {badValue
  287.         {{unknown option "-bitmap"} 
  288.         {bitmap "badValue" not defined}
  289.         {bitmap "badValue" not defined}
  290.         {unknown option "-bitmap"}
  291.         {bitmap "badValue" not defined}
  292.         {bitmap "badValue" not defined}
  293.         }
  294.     }}
  295.     }
  296.     {-columnbreak
  297.     {{1
  298.         {{unknown option "-columnbreak"} 1 1 {unknown option "-columnbreak"} 1 1}
  299.     }}
  300.     }
  301.     {-command
  302.         {{beep 
  303.             {{unknown option "-command"} beep beep 
  304.             {unknown option "-command"} beep beep
  305.         }
  306.     }}
  307.     }
  308.     {-font
  309.         {{-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
  310.             {{unknown option "-font"}
  311.             -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
  312.             -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
  313.             {unknown option "-font"} 
  314.             -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
  315.             -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
  316.         }
  317.     }
  318.     {{kill rock stars}
  319.         {{unknown option "-font"}
  320.         {expected integer but got "rock"}
  321.         {expected integer but got "rock"}
  322.         {unknown option "-font"}
  323.         {expected integer but got "rock"}
  324.         {expected integer but got "rock"}
  325.         }
  326.     }}
  327.     }
  328.     {-foreground
  329.         {{#110022 
  330.             {{unknown option "-foreground"} #110022 #110022 
  331.             {unknown option "-foreground"} #110022 #110022
  332.         }
  333.     }
  334.     {non-existent
  335.         {{unknown option "-foreground"} 
  336.         {unknown color name "non-existent"}
  337.         {unknown color name "non-existent"}
  338.         {unknown option "-foreground"}
  339.         {unknown color name "non-existent"}
  340.         {unknown color name "non-existent"}
  341.         }
  342.     }}
  343.     }
  344.     {-image
  345.         {{image1 
  346.             {{unknown option "-image"} image1 image1 
  347.             {unknown option "-image"} image1 image1
  348.         }
  349.     }
  350.     {bogus
  351.         {{unknown option "-image"} 
  352.         {image "bogus" doesn't exist}
  353.         {image "bogus" doesn't exist}
  354.         {unknown option "-image"}
  355.         {image "bogus" doesn't exist}
  356.         {image "bogus" doesn't exist}
  357.         }
  358.     }
  359.     {""
  360.         {{unknown option "-image"}
  361.         {}
  362.         {}
  363.         {unknown option "-image"}
  364.         {}
  365.         {}
  366.         }
  367.     }}
  368.     }
  369.     {-indicatoron
  370.         {{1 
  371.             {{unknown option "-indicatoron"}
  372.             {unknown option "-indicatoron"}
  373.             {unknown option "-indicatoron"} 
  374.             {unknown option "-indicatoron"} 1 1
  375.         }
  376.     }}
  377.     }
  378.     {-label
  379.         {{test 
  380.             {{unknown option "-label"} test test 
  381.             {unknown option "-label"} test test
  382.         }
  383.     }}
  384.     }
  385.     {-menu
  386.         {{.m2 
  387.             {{unknown option "-menu"}
  388.             {unknown option "-menu"} .m2 
  389.             {unknown option "-menu"}
  390.             {unknown option "-menu"}
  391.             {unknown option "-menu"}
  392.         }
  393.     }}
  394.     }
  395.     {-offvalue
  396.         {{off
  397.             {{unknown option "-offvalue"} 
  398.             {unknown option "-offvalue"}
  399.         {unknown option "-offvalue"}
  400.             {unknown option "-offvalue"}
  401.             off
  402.             {unknown option "-offvalue"}
  403.         }
  404.     }}
  405.     }
  406.     {-onvalue
  407.         {{on
  408.             {{unknown option "-onvalue"}
  409.             {unknown option "-onvalue"}
  410.             {unknown option "-onvalue"}
  411.             {unknown option "-onvalue"}
  412.             on 
  413.               {unknown option "-onvalue"}
  414.         }
  415.     }}
  416.     }
  417.     {-selectcolor
  418.         {{#110022 
  419.             {{unknown option "-selectcolor"} 
  420.             {unknown option "-selectcolor"}
  421.             {unknown option "-selectcolor"} 
  422.             {unknown option "-selectcolor"}
  423.             #110022
  424.             #110022
  425.         }
  426.     }
  427.     {non-existent
  428.         {{unknown option "-selectcolor"} 
  429.         {unknown option "-selectcolor"}
  430.         {unknown option "-selectcolor"}
  431.         {unknown option "-selectcolor"}
  432.         {unknown color name "non-existent"}
  433.         {unknown color name "non-existent"}
  434.         }
  435.     }}
  436.     }
  437.     {-selectimage
  438.         {{image1 
  439.             {{unknown option "-selectimage"}
  440.             {unknown option "-selectimage"}
  441.             {unknown option "-selectimage"} 
  442.             {unknown option "-selectimage"} image1 image1
  443.         }
  444.     }
  445.     {bogus
  446.         {{unknown option "-selectimage"} 
  447.         {unknown option "-selectimage"}
  448.         {unknown option "-selectimage"}
  449.         {unknown option "-selectimage"}
  450.         {image "bogus" doesn't exist}
  451.         {image "bogus" doesn't exist}
  452.         }
  453.     }
  454.     {""
  455.         {{unknown option "-selectimage"}
  456.         {unknown option "-selectimage"}
  457.         {unknown option "-selectimage"}
  458.         {unknown option "-selectimage"}
  459.         {}
  460.         {}
  461.         }
  462.     }}
  463.     }
  464.     {-state
  465.         {{normal 
  466.             {normal normal normal 
  467.             {unknown option "-state"} normal normal
  468.         }
  469.     }}
  470.     }
  471.     {-value
  472.         {{"any string"
  473.             {{unknown option "-value"}
  474.             {unknown option "-value"}
  475.             {unknown option "-value"}
  476.             {unknown option "-value"}
  477.             {unknown option "-value"} "any string"
  478.         }
  479.     }}
  480.     }
  481.     {-variable
  482.         {{"any string"
  483.             {{unknown option "-variable"}
  484.             {unknown option "-variable"}
  485.             {unknown option "-variable"} 
  486.             {unknown option "-variable"}
  487.             "any string"
  488.             "any string"
  489.         }
  490.     }}
  491.     }
  492.     {-underline
  493.         {{0 
  494.             {{unknown option "-underline"} 0 0 
  495.             {unknown option "-underline"} 0 0
  496.         }
  497.     }
  498.     {3p
  499.         {{unknown option "-underline"} 
  500.         {expected integer but got "3p"}
  501.         {expected integer but got "3p"}
  502.         {unknown option "-underline"}
  503.         {expected integer but got "3p"}
  504.         {expected integer but got "3p"}
  505.         }
  506.     }}
  507.     }
  508. } {
  509.     set name [lindex $test 0]
  510.     foreach attempt [lindex $test 1] {
  511.         set value [lindex $attempt 0]
  512.         set options [lindex $attempt 1]
  513.         foreach item {0 1 2 3 4 5} {
  514.             catch {unset msg}
  515.             test menu-2.$i [list entry configuration options $name $item $value] {
  516.                 set result [catch {.m1 entryconfigure $item $name $value} msg]
  517.                 if {$result == 1} {
  518.                     set msg
  519.                 } else {
  520.                     lindex [.m1 entryconfigure $item $name] 4
  521.                 }
  522.             } [lindex $options $item]
  523.             incr i
  524.         }
  525.     }
  526. }
  527.  
  528. image delete image1
  529. destroy .m1
  530. destroy .m2
  531.  
  532. test menu-3.1 {MenuWidgetCmd procedure} {
  533.     catch {destroy .m1}
  534.     menu .m1
  535.     list [catch {.m1} msg] $msg [destroy .m1]
  536. } {1 {wrong # args: should be ".m1 option ?arg arg ...?"} {}}
  537. test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} {menuInteractive} {
  538.     catch {destroy .m1}
  539.     menu .m1 -postcommand "destroy .m1"
  540.     .m1 add command -label "menu-3.2: Hit Escape"
  541.     list [catch {.m1 post 40 40} msg] $msg
  542. } {0 {}}
  543. test menu-3.3 {MenuWidgetCmd procedure, "activate" option} {
  544.     catch {destroy .m1}
  545.     menu .m1
  546.     .m1 add command -label "test"
  547.     list [catch {.m1 activate} msg] $msg [destroy .m1]
  548. } {1 {wrong # args: should be ".m1 activate index"} {}}
  549. test menu-3.4 {MenuWidgetCmd procedure, "activate" option} {
  550.     catch {destroy .m1}
  551.     menu .m1
  552.     list [catch {.m1 activate "foo"} msg] $msg [destroy .m1]
  553. } {1 {bad menu entry index "foo"} {}}
  554. test menu-3.5 {MenuWidgetCmd procedure, "activate" option}  {
  555.     catch {destroy .m1}
  556.     menu .m1
  557.     .m1 add command -label "test"
  558.     .m1 add separator
  559.     list [catch {.m1 activate 2} msg] $msg [destroy .m1]
  560. } {0 {} {}}
  561. test menu-3.6 {MenuWidgetCmd procedure, "activate" option}  {
  562.     catch {destroy .m1}
  563.     menu .m1
  564.     .m1 add command -label "test"
  565.     .m1 entryconfigure 1 -state disabled
  566.     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
  567. } {0 {} {}}
  568. test menu-3.7 {MenuWidgetCmd procedure, "activate" option}  {
  569.     catch {destroy .m1}
  570.     menu .m1
  571.     .m1 add command -label "test"
  572.     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
  573. } {0 {} {}}
  574. test menu-3.8 {MenuWidgetCmd procedure, "add" option} {
  575.     catch {destroy .m1}
  576.     menu .m1
  577.     list [catch {.m1 add} msg] $msg [destroy .m1]
  578. } {1 {wrong # args: should be ".m1 add type ?options?"} {}}
  579. test menu-3.9 {MenuWidgetCmd procedure, "add" option} {
  580.     catch {destroy .m1}
  581.     menu .m1
  582.     list [catch {.m1 add foo} msg] $msg [destroy .m1]
  583. } {1 {bad menu entry type "foo": must be cascade, checkbutton, command, radiobutton, or separator} {}}
  584. test menu-3.10 {MenuWidgetCmd procedure, "add" option} {
  585.     catch {destroy .m1}
  586.     menu .m1
  587.     list [catch {.m1 add separator} msg] $msg [destroy .m1]
  588. } {0 {} {}}
  589. test menu-3.11 {MenuWidgetCmd procedure, "cget" option} {
  590.     catch {destroy .m1}
  591.     menu .m1
  592.     list [catch {.m1 cget} msg] $msg [destroy .m1]
  593. } {1 {wrong # args: should be ".m1 cget option"} {}}
  594. test menu-3.12 {MenuWidgetCmd procedure, "cget" option} {
  595.     catch {destroy .m1}
  596.     menu .m1
  597.     list [catch {.m1 cget -gorp} msg] $msg [destroy .m1]
  598. } {1 {unknown option "-gorp"} {}}
  599. test menu-3.13 {MenuWidgetCmd procedure, "cget" option} {
  600.     catch {destroy .m1}
  601.     menu .m1
  602.     .m1 configure -postcommand "Some string"
  603.     list [catch {.m1 cget -postcommand} msg] $msg [destroy .m1]
  604. } {0 {Some string} {}}
  605. test menu-3.14 {MenuWidgetCmd procedure, "clone" option} {
  606.     catch {destroy .m1}
  607.     menu .m1
  608.     list [catch {.m1 clone} msg] $msg [destroy .m1]
  609. } {1 {wrong # args: should be ".m1 clone newMenuName ?menuType?"} {}}
  610. test menu-3.15 {MenuWidgetCmd procedure, "clone" option} {
  611.     catch {destroy .m1}
  612.     menu .m1
  613.     list [catch {.m1 clone a b c d} msg] $msg [destroy .m1]
  614. } {1 {wrong # args: should be ".m1 clone newMenuName ?menuType?"} {}}
  615. test menu-3.16 {MenuWidgetCmd procedure, "clone" option} {
  616.     catch {destroy .m1}
  617.     menu .m1
  618.     list [catch {.m1 clone .m1.clone1} msg] $msg [destroy .m1]
  619. } {0 {} {}}
  620. test menu-3.17 {MenuWidgetCmd procedure, "clone" option} {
  621.     catch {destroy .m1}
  622.     menu .m1
  623.     list [catch {.m1 clone .m1.clone1 tearoff} msg] $msg [destroy .m1]
  624. } {0 {} {}}
  625. test menu-3.18 {MenuWidgetCmd procedure, "configure" option} {
  626.     catch {destroy .m1}
  627.     menu .m1
  628.     list [catch {llength [.m1 configure]} msg] $msg [destroy .m1]
  629. } {0 20 {}}
  630. test menu-3.19 {MenuWidgetCmd procedure, "configure" option} {
  631.     catch {destroy .m1}
  632.     menu .m1
  633.     list [catch {.m1 configure -gorp} msg] $msg [destroy .m1]
  634. } {1 {unknown option "-gorp"} {}}
  635. test menu-3.20 {MenuWidgetCmd procedure, "configure" option} {
  636.     catch {destroy .m1}
  637.     menu .m1
  638.     list [catch {.m1 configure -postcommand "A random String"} msg] $msg [destroy .m1]
  639. } {0 {} {}}
  640. test menu-3.21 {MenuWidgetCmd procedure, "configure" option} {
  641.     catch {destroy .m1}
  642.     menu .m1
  643.     .m1 configure -postcommand "Another string"
  644.     list [catch {lindex [.m1 configure -postcommand] 4} msg] $msg [destroy .m1]
  645. } {0 {Another string} {}}
  646. test menu-3.22 {MenuWidgetCmd procedure, "delete" option} {
  647.     catch {destroy .m1}
  648.     menu .m1
  649.     list [catch {.m1 delete} msg] $msg [destroy .m1]
  650. } {1 {wrong # args: should be ".m1 delete first ?last?"} {}}
  651. test menu-3.23 {MenuWidgetCmd procedure, "delete" option} {
  652.     catch {destroy .m1}
  653.     menu .m1
  654.     list [catch {.m1 delete foo} msg] $msg [destroy .m1]
  655. } {1 {bad menu entry index "foo"} {}}
  656. test menu-3.24 {MenuWidgetCmd procedure, "delete" option} {
  657.     catch {destroy .m1}
  658.     menu .m1
  659.     list [catch {.m1 delete 0 "foo"} msg] $msg [destroy .m1]
  660. } {1 {bad menu entry index "foo"} {}}
  661. test menu-3.25 {MenuWidgetCmd procedure, "delete" option} {
  662.     catch {destroy .m1}
  663.     menu .m1
  664.     list [catch {.m1 delete 0} msg] $msg [destroy .m1]
  665. } {0 {} {}}
  666. test menu-3.26 {MenuWidgetCmd procedure, "delete" option} {
  667.     catch {destroy .m1}
  668.     menu .m1
  669.     .m1 add command -label "foo"
  670.     list [catch {.m1 delete 1 0} msg] $msg [destroy .m1] 
  671. } {0 {} {}}
  672. test menu-3.27 {MenuWidgetCmd procedure, "delete" option} {
  673.     catch {destroy .m1}
  674.     menu .m1
  675.     .m1 add command -label "1"
  676.     .m1 add command -label "2"
  677.     .m1 add command -label "3"
  678.     list [catch {.m1 delete 1 3} msg] $msg [destroy .m1]
  679. } {0 {} {}}
  680. test menu-3.28 {MenuWidgetCmd procedure, "delete" option} {
  681.     catch {destroy .m1}
  682.     menu .m1
  683.     .m1 add command -label "1"
  684.     .m1 add command -label "2"
  685.     .m1 add command -label "3"
  686.     .m1 activate 2
  687.     list [catch {.m1 delete 1 3} msg] $msg [destroy .m1]
  688. } {0 {} {}}
  689. test menu-3.29 {MenuWidgetCmd procedure, "delete" option} {
  690.     catch {destroy .m1}
  691.     menu .m1
  692.     .m1 add command -label "1"
  693.     .m1 add command -label "2"
  694.     .m1 add command -label "3"
  695.     .m1 activate 3
  696.     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
  697. } {0 {} {}}
  698. test menu-3.30 {MenuWidgetCmd procedure, "entrycget" option} {
  699.     catch {destroy .m1}
  700.     menu .m1
  701.     list [catch {.m1 entrycget} msg] $msg [destroy .m1]
  702. } {1 {wrong # args: should be ".m1 entrycget index option"} {}}
  703. test menu-3.31 {MenuWidgetCmd procedure, "entrycget" option} {
  704.     catch {destroy .m1}
  705.     menu .m1
  706.     list [catch {.m1 entrycget index option foo} msg] $msg [destroy .m1]
  707. } {1 {wrong # args: should be ".m1 entrycget index option"} {}}
  708. test menu-3.32 {MenuWidgetCmd procedure, "entrycget" option} {
  709.     catch {destroy .m1}
  710.     menu .m1
  711.     list [catch {.m1 entrycget foo -label} msg] $msg [destroy .m1]
  712. } {1 {bad menu entry index "foo"} {}}
  713. test menu-3.33 {MenuWidgetCmd procedure, "entrycget" option} {
  714.     catch {destroy .m1}
  715.     menu .m1
  716.     .m1 add command -label "test"
  717.     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
  718. } {0 test {}}
  719. test menu-3.34 {MenuWidgetCmd procedure, "entryconfigure" option} {
  720.     catch {destroy .m1}
  721.     menu .m1
  722.     list [catch {.m1 entryconfigure} msg] $msg [destroy .m1]
  723. } {1 {wrong # args: should be ".m1 entryconfigure index ?option value ...?"} {}}
  724. test menu-3.35 {MenuWidgetCmd procedure, "entryconfigure" option} {
  725.     catch {destroy .m1}
  726.     menu .m1
  727.     list [catch {.m1 entryconfigure foo} msg] $msg [destroy .m1]
  728. } {1 {bad menu entry index "foo"} {}}
  729. test menu-3.36 {MenuWidgetCmd procedure, "entryconfigure" option} {
  730.     catch {destroy .m1}
  731.     menu .m1
  732.     .m1 add command -label "test"
  733.     list [catch {llength [.m1 entryconfigure 1]} msg] $msg [destroy .m1]
  734. } {0 14 {}}
  735. test menu-3.37 {MenuWidgetCmd procedure, "entryconfigure" option} {
  736.     catch {destroy .m1}
  737.     menu .m1
  738.     .m1 add command -label "test"
  739.     list [catch {lindex [.m1 entryconfigure 1 -label] 4} msg] $msg [destroy .m1]
  740. } {0 test {}}
  741. test menu-3.38 {MenuWidgetCmd procedure, "entryconfigure" option} {
  742.     catch {destroy .m1}
  743.     menu .m1
  744.     .m1 add command -label "test"
  745.     .m1 entryconfigure 1 -label "changed"
  746.     list [catch {lindex [.m1 entryconfigure 1 -label] 4} msg] $msg [destroy .m1]
  747. } {0 changed {}}
  748. test menu-3.39 {MenuWidgetCmd procedure, "index" option} {
  749.     catch {destroy .m1}
  750.     menu .m1
  751.     list [catch {.m1 index} msg] $msg [destroy .m1]
  752. } {1 {wrong # args: should be ".m1 index string"} {}}
  753. test menu-3.40 {MenuWidgetCmd procedure, "index" option} {
  754.     catch {destroy .m1}
  755.     menu .m1
  756.     list [catch {.m1 index foo} msg] $msg [destroy .m1]
  757. } {1 {bad menu entry index "foo"} {}}
  758. test menu-3.41 {MenuWidgetCmd procedure, "index" option} {
  759.     catch {destroy .m1}
  760.     menu .m1
  761.     .m1 add command -label "test"
  762.     list [catch {.m1 index "test"} msg] $msg [destroy .m1]
  763. } {0 1 {}}
  764. test menu-3.42 {MenuWidgetCmd procedure, "insert" option} {
  765.     catch {destroy .m1}
  766.     menu .m1
  767.     list [catch {.m1 insert} msg] $msg [destroy .m1]
  768. } {1 {wrong # args: should be ".m1 insert index type ?options?"} {}}
  769. test menu-3.43 {MenuWidgetCmd procedure, "insert" option} {
  770.     catch {destroy .m1}
  771.     menu .m1
  772.     .m1 insert 1 command -label "test"
  773.     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
  774. } {0 test {}}
  775. test menu-3.44 {MenuWidgetCmd procedure, "invoke" option} {
  776.     catch {destroy .m1}
  777.     menu .m1
  778.     list [catch {.m1 invoke} msg] $msg [destroy .m1]
  779. } {1 {wrong # args: should be ".m1 invoke index"} {}}
  780. test menu-3.45 {MenuWidgetCmd procedure, "invoke" option} {
  781.     catch {destroy .m1}
  782.     menu .m1
  783.     list [catch {.m1 invoke foo} msg] $msg [destroy .m1]
  784. } {1 {bad menu entry index "foo"} {}}
  785. test menu-3.46 {MenuWidgetCmd procedure, "invoke" option} {
  786.     catch {destroy .m1}
  787.     catch {unset foo}
  788.     menu .m1
  789.     .m1 add command -label "set foo" -command "set foo hello"
  790.     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
  791. } {0 hello 0 hello 0 {} {}}
  792. test menu-3.47 {MenuWidgetCmd procedure, "post" option} {
  793.     catch {destroy .m1}
  794.     menu .m1
  795.     .m1 add command -label "On Windows, hit Escape to get this menu to go away"
  796.     list [catch {.m1 post} msg] $msg [destroy .m1]
  797. } {1 {wrong # args: should be ".m1 post x y"} {}}
  798. test menu-3.48 {MenuWidgetCmd procedure, "post" option} {
  799.     catch {destroy .m1}
  800.     menu .m1
  801.     list [catch {.m1 post foo 40} msg] $msg [destroy .m1]
  802. } {1 {expected integer but got "foo"} {}}
  803. test menu-3.49 {MenuWidgetCmd procedure, "post" option} {
  804.     catch {destroy .m1}
  805.     menu .m1
  806.     list [catch {.m1 post 40 bar} msg] $msg [destroy .m1]
  807. } {1 {expected integer but got "bar"} {}}
  808. test menu-3.50 {MenuWidgetCmd procedure, "post" option} {menuInteractive} {
  809.     catch {destroy .m1}
  810.     menu .m1
  811.     .m1 add command -label "menu-3.53: hit Escape" -command "puts hello"
  812.     list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
  813. } {0 {} {}}
  814. test menu-3.51 {MenuWidgetCmd procedure, "postcascade" option} {
  815.     catch {destroy .m1}
  816.     menu .m1
  817.     list [catch {.m1 postcascade} msg] $msg [destroy .m1]
  818. } {1 {wrong # args: should be ".m1 postcascade index"} {}}
  819. test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} {
  820.     catch {destroy .m1}
  821.     menu .m1
  822.     list [catch {.m1 postcascade foo} msg] $msg [destroy .m1]
  823. } {1 {bad menu entry index "foo"} {}}
  824. test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {menuInteractive} {
  825.     catch {destroy .m1}
  826.     catch {destroy .m2}
  827.     menu .m1
  828.     .m1 add command -label "menu-3.56 - hit Escape"
  829.     menu .m2
  830.     .m1 post 40 40
  831.     .m1 add cascade -menu .m2
  832.     list [catch {.m1 postcascade 1} msg] $msg [destroy .m1 .m2]
  833. } {0 {} {}}
  834. test menu-3.54 {MenuWidgetCmd procedure, "postcascade" option} {
  835.     catch {destroy .m1}
  836.     catch {destroy .m2}
  837.     menu .m1
  838.     menu .m2
  839.     .m1 add cascade -menu .m2 -label "menu-3.57 - hit Escape"
  840.     .m1 postcascade 1
  841.     list [catch {.m1 postcascade none} msg] $msg [destroy .m1 .m2]
  842. } {0 {} {}}
  843. test menu-3.55 {MenuWidgetCmd procedure, "type" option} {
  844.     catch {destroy .m1}
  845.     menu .m1
  846.     list [catch {.m1 type} msg] $msg [destroy .m1]
  847. } {1 {wrong # args: should be ".m1 type index"} {}}
  848. test menu-3.56 {MenuWidgetCmd procedure, "type" option} {
  849.     catch {destroy .m1}
  850.     menu .m1
  851.     list [catch {.m1 type foo} msg] $msg [destroy .m1]
  852. } {1 {bad menu entry index "foo"} {}}
  853. test menu-3.57 {MenuWidgetCmd procedure, "type" option} {
  854.     catch {destroy .m1}
  855.     menu .m1
  856.     .m1 add command -label "test"
  857.     list [catch {.m1 type 1} msg] $msg [destroy .m1]
  858. } {0 command {}}
  859. test menu-3.58 {MenuWidgetCmd procedure, "type" option} {
  860.     catch {destroy .m1}
  861.     menu .m1
  862.     .m1 add separator
  863.     list [catch {.m1 type 1} msg] $msg [destroy .m1]
  864. } {0 separator {}}
  865. test menu-3.59 {MenuWidgetCmd procedure, "type" option} {
  866.     catch {destroy .m1}
  867.     menu .m1
  868.     .m1 add checkbutton -label "test"
  869.     list [catch {.m1 type 1} msg] $msg [destroy .m1]
  870. } {0 checkbutton {}}
  871. test menu-3.60 {MenuWidgetCmd procedure, "type" option} {
  872.     catch {destroy .m1}
  873.     menu .m1
  874.     .m1 add radiobutton -label "test"
  875.     list [catch {.m1 type 1} msg] $msg [destroy .m1]
  876. } {0 radiobutton {}}
  877. test menu-3.61 {MenuWidgetCmd procedure, "type" option} {
  878.     catch {destroy .m1}
  879.     menu .m1
  880.     .m1 add cascade -label "test"
  881.     list [catch {.m1 type 1} msg] $msg [destroy .m1]
  882. } {0 cascade {}}
  883. test menu-3.62 {MenuWidgetCmd procedure, "type" option} {
  884.     catch {destroy .m1}
  885.     menu .m1
  886.     list [catch {.m1 type 0} msg] $msg [destroy .m1]
  887. } {0 tearoff {}}
  888. test menu-3.63 {MenuWidgetCmd procedure, "unpost" option} {
  889.     catch {destroy .m1}
  890.     menu .m1
  891.     list [catch {.m1 unpost foo} msg] $msg [destroy .m1]
  892. } {1 {wrong # args: should be ".m1 unpost"} {}}
  893. test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} {menuInteractive} {
  894.     catch {destroy .m1}
  895.     menu .m1
  896.     .m1 add command -label "menu-3.68 - hit Escape"
  897.     .m1 post 40 40 
  898.     list [catch {.m1 unpost} msg] $msg [destroy .m1]
  899. } {0 {} {}}
  900. test menu-3.65 {MenuWidgetCmd procedure, "yposition" option} {
  901.     catch {destroy .m1}
  902.     menu .m1
  903.     list [catch {.m1 yposition} msg] $msg [destroy .m1]
  904. } {1 {wrong # args: should be ".m1 yposition index"} {}}
  905. test menu-3.66 {MenuWidgetCmd procedure, "yposition" option} {
  906.     catch {destroy .m1}
  907.     menu .m1
  908.     list [catch {.m1 yposition 1}] [destroy .m1]
  909. } {0 {}}
  910. test menu-3.67 {MenuWidgetCmd procedure, bad option} {
  911.     catch {destroy .m1}
  912.     menu .m1
  913.     list [catch {.m1 foo} msg] $msg [destroy .m1]
  914. } {1 {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, or yposition} {}}
  915.  
  916. test menu-4.1 {TkInvokeMenu} {
  917.     catch {destroy .m1}
  918.     menu .m1
  919.     list [catch {.m1 invoke 0} msg] [destroy .m1]
  920. } {0 {}}
  921. test menu-4.2 {TkInvokeMenu} {
  922.     catch {destroy .m1}
  923.     catch {unset foo}
  924.     menu .m1
  925.     .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
  926.     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
  927. } {0 {} 0 on 0 {} {}}
  928. test menu-4.3 {TkInvokeMenu} {
  929.     catch {destroy .m1}
  930.     catch {unset foo}
  931.     menu .m1
  932.     .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
  933.     .m1 invoke 1
  934.     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
  935. } {0 {} 0 off 0 {} {}}
  936. test menu-4.4 {TkInvokeMenu} {
  937.     catch {destroy .m1}
  938.     catch {unset foo}
  939.     menu .m1
  940.     .m1 add radiobutton -label "1" -variable foo -value one
  941.     .m1 add radiobutton -label "2" -variable foo -value two
  942.     .m1 add radiobutton -label "3" -variable foo -value three
  943.     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
  944. } {0 {} 0 one 0 {} {}}
  945. test menu-4.5 {TkInvokeMenu} {
  946.     catch {destroy .m1}
  947.     catch {unset foo}
  948.     menu .m1
  949.     .m1 add radiobutton -label "1" -variable foo -value one
  950.     .m1 add radiobutton -label "2" -variable foo -value two
  951.     .m1 add radiobutton -label "3" -variable foo -value three
  952.     list [catch {.m1 invoke 2} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
  953. } {0 {} 0 two 0 {} {}}
  954. test menu-4.6 {TkInvokeMenu} {
  955.     catch {destroy .m1}
  956.     catch {unset foo}
  957.     menu .m1
  958.     .m1 add radiobutton -label "1" -variable foo -value one
  959.     .m1 add radiobutton -label "2" -variable foo -value two
  960.     .m1 add radiobutton -label "3" -variable foo -value three
  961.     list [catch {.m1 invoke 3} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
  962. } {0 {} 0 three 0 {} {}}
  963. test menu-4.7 {TkInvokeMenu} {
  964.     catch {destroy .m1}
  965.     catch {unset menu_test}
  966.     menu .m1
  967.     .m1 add command -label "test" -command "set menu_test menu-4.8"
  968.     list [catch {.m1 invoke 1} msg] $msg [catch {set menu_test} msg2] $msg2 [catch {unset menu_test} msg3] $msg3 [destroy .m1]
  969. } {0 menu-4.8 0 menu-4.8 0 {} {}}
  970. test menu-4.8 {TkInvokeMenu} {
  971.     catch {destroy .m1}
  972.     menu .m1
  973.     .m1 add cascade -label "test" -menu .m1.m2
  974.     list [catch {.m1 invoke 1} msg] $msg [destroy .m1]
  975. } {0 {} {}}
  976. test menu-4.9 {TkInvokeMenu} {
  977.     catch {destroy .m1}
  978.     menu .m1
  979.     .m1 add command -label "test" -command ".m1 delete 1"
  980.     list [catch {.m1 invoke 1} msg] $msg [catch {.m1 type "test"} msg2] $msg2 [destroy .m1]
  981. } {0 {} 1 {bad menu entry index "test"} {}}
  982.  
  983. test menu-5.1 {DestroyMenuInstance} {
  984.     catch {destroy .m1}
  985.     menu .m1
  986.     list [catch {destroy .m1} msg] $msg
  987. } {0 {}}
  988. test menu-5.2 {DestroyMenuInstance - cascade menu} {
  989.     catch {destroy .m1}
  990.     catch {destroy .m2}
  991.     menu .m1
  992.     .m1 add cascade -menu .m2
  993.     menu .m2
  994.     list [catch {destroy .m2} msg] $msg [destroy .m1]
  995. } {0 {} {}}
  996. test menu-5.3 {DestroyMenuInstance - multiple cascade parents} {
  997.     catch {destroy .m1}
  998.     catch {destroy .m2}
  999.     catch {destroy .m3}
  1000.     menu .m1
  1001.     .m1 add cascade -menu .m3
  1002.     menu .m2
  1003.     .m2 add cascade -menu .m3
  1004.     menu .m3
  1005.     list [catch {destroy .m3} msg] $msg [destroy .m1 .m2]
  1006. } {0 {} {}}
  1007. test menu-5.4 {DestroyMenuInstance - multiple cascade parents} {
  1008.     catch {destroy .m1}
  1009.     catch {destroy .m2}
  1010.     catch {destroy .m3}
  1011.     catch {destroy .m4}
  1012.     menu .m1
  1013.     .m1 add cascade -menu .m4
  1014.     menu .m2
  1015.     .m2 add cascade -menu .m4
  1016.     menu .m3
  1017.     .m3 add cascade -menu .m4
  1018.     menu .m4
  1019.     list [catch {destroy .m4} msg] $msg [destroy .m1 .m2 .m3]
  1020. } {0 {} {}}
  1021. test menu-5.5 {DestroyMenuInstance - cascades of cloned menus} {
  1022.     catch {destroy .m1}
  1023.     catch {destroy .m2}
  1024.     menu .m1
  1025.     menu .m2
  1026.     .m1 add cascade -menu .m2
  1027.     . configure -menu .m1
  1028.     list [catch {destroy .m2} msg] $msg [.m1 entrycget 1 -menu] [. configure -menu ""] [destroy .m1]
  1029. } {0 {} .m2 {} {}}
  1030. test menu-5.6 {DestroyMenuInstance - cascades of cloned menus} {
  1031.     catch {destroy .m1}
  1032.     catch {destroy .m2}
  1033.     catch {destroy .t2}
  1034.     menu .m1
  1035.     .m1 add cascade -menu .m2
  1036.     menu .m2
  1037.     . configure -menu .m1
  1038.     toplevel .t2
  1039.     wm geometry .t2 +0+0
  1040.     .t2 configure -menu .m1
  1041.     list [catch {destroy .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
  1042. } {0 {} {} {}}
  1043. test menu-5.7 {DestroyMenuInstance - basic clones} {
  1044.     catch {destroy .m1}
  1045.     menu .m1
  1046.     set tearoff [tkTearOffMenu .m1]
  1047.     list [catch {destroy $tearoff} msg] $msg [destroy .m1]
  1048. } {0 {} {}}
  1049. test menu-5.8 {DestroyMenuInstance - multiple clones} {
  1050.     catch {destroy .m1}
  1051.     menu .m1
  1052.     set tearoff1 [tkTearOffMenu .m1]
  1053.     set tearoff2 [tkTearOffMenu .m1]
  1054.     list [catch {destroy $tearoff1} msg] $msg [destroy .m1]
  1055. } {0 {} {}}
  1056. test menu-5.9 {DestroyMenuInstace - master menu} {
  1057.     catch {destroy .m1}
  1058.     menu .m1
  1059.     tkTearOffMenu .m1
  1060.     list [catch {destroy .m1} msg] $msg
  1061. } {0 {}}
  1062. test menu-5.10 {DestroyMenuInstance - freeing entries} {
  1063.     catch {destroy .m1}
  1064.     menu .m1
  1065.     .m1 add command -label "foo"
  1066.     list [catch {destroy .m1} msg] $msg
  1067. } {0 {}}
  1068. test menu-5.11 {DestroyMenuInstace - no entries} {
  1069.     catch {destroy .m1}
  1070.     menu .m1
  1071.     .m1 configure -tearoff 0
  1072.     list [catch {destroy .m1} msg] $msg
  1073. } {0 {}}
  1074. test menu-5.12 {DestroyMenuInstance - platform data} {
  1075.     catch {destroy .m1}
  1076.     menu .m1
  1077.     list [catch {destroy .m1} msg] $msg
  1078. } {0 {}}
  1079. test menu-5.13 {DestroyMenuInstance - clones when mismatched tearoffs} {
  1080.     catch {destroy .m1}
  1081.     catch {destroy .m2}
  1082.     menu .m1
  1083.     menu .m2
  1084.     .m1 add cascade -menu .m2
  1085.     set tearoff [tkTearOffMenu .m1 40 40]
  1086.     list [destroy .m2] [destroy .m1]
  1087. } {{} {}}
  1088.  
  1089. test menu-6.1 {TkDestroyMenu} {
  1090.     catch {destroy .m1}
  1091.     menu .m1
  1092.     list [catch {destroy .m1} msg] $msg
  1093. } {0 {}}
  1094. test menu-6.2 {TkDestroyMenu - reentrancy} {
  1095.     catch {destroy .m1}
  1096.     catch {destroy .m2}
  1097.     menu .m1
  1098.     bind .m1 <Destroy> {destroy .m1}
  1099.     menu .m2
  1100.     bind .m2 <Destroy> {destroy .m2}
  1101.     list [catch {destroy .m1} msg] $msg [destroy .m2]
  1102. } {0 {} {}}
  1103. test menu-6.3 {TkDestroyMenu - reentrancy} {
  1104.     catch {destroy .m1}
  1105.     catch {destroy .m2}
  1106.     catch {destroy .m3}
  1107.     menu .m1
  1108.     bind .m1 <Destroy> {destroy .m2}
  1109.     .m1 clone .m2
  1110.     .m1 clone .m3
  1111.     list [catch {destroy .m1} msg] $msg [winfo exists .m2]
  1112. } {0 {} 0}
  1113. test menu-6.4 {TkDestroyMenu - reentrancy - clones} {
  1114.     catch {destroy .m1}
  1115.     catch {destroy .m2}
  1116.     menu .m1
  1117.     .m1 clone .m2
  1118.     .m1 clone .m1.m3
  1119.     list [catch {destroy .m1} msg] $msg
  1120. } {0 {}}
  1121. test menu-6.5 {TkDestroyMenu} {
  1122.     catch {destroy .m1}
  1123.     catch {destroy .m2}
  1124.     menu .m1
  1125.     .m1 clone .m2
  1126.     destroy .m1
  1127.     winfo exists .m2
  1128. } {0}
  1129. test menu-6.6 {TkDestroyMenu} {
  1130.     catch {destroy .m1}
  1131.     catch {destroy .m2}
  1132.     menu .m1
  1133.     .m1 clone .m2 tearoff
  1134.     list [catch {destroy .m1} msg] $msg
  1135. } {0 {}}
  1136. test menu-6.7 {TkDestroyMenu} {
  1137.     catch {destroy .m1}
  1138.     catch {destroy .m2}
  1139.     menu .m1
  1140.     .m1 clone .m2
  1141.     destroy .m2
  1142.     list [catch {destroy .m1} msg] $msg
  1143. } {0 {}}
  1144. test menu-6.8 {TkDestroyMenu} {
  1145.     catch {destroy .m1}
  1146.     catch {destroy .m2}
  1147.     catch {destroy .m3}
  1148.     menu .m1
  1149.     .m1 clone .m2
  1150.     .m1 clone .m3
  1151.     destroy .m1
  1152.     list [winfo exists .m2] [winfo exists .m3]
  1153. } {0 0}
  1154. test menu-6.9 {TkDestroyMenu} {
  1155.     catch {destroy .m1}
  1156.     catch {destroy .m2}
  1157.     catch {destroy .m3}
  1158.     menu .m1
  1159.     .m1 clone .m2
  1160.     .m1 clone .m3
  1161.     list [catch {destroy .m2} msg] $msg [catch {destroy .m3} msg2] $msg2 [catch {destroy .m1} msg3] $msg3
  1162. } {0 {} 0 {} 0 {}}
  1163. test menu-6.10 {TkDestroyMenu} {
  1164.     catch {destroy .m1}
  1165.     catch {destroy .m2}
  1166.     catch {destroy .m3}
  1167.     menu .m1
  1168.     .m1 clone .m2
  1169.     .m1 clone .m3
  1170.     list [catch {destroy .m3} msg] $msg [catch {destroy .m1} msg2] $msg2
  1171. } {0 {} 0 {}}
  1172. test menu-6.11 {TkDestroyMenu} {
  1173.     catch {destroy .m1}
  1174.     catch {destroy .m2}
  1175.     catch {destroy .m3}
  1176.     catch {destroy .m4}
  1177.     menu .m1
  1178.     .m1 clone .m2
  1179.     .m1 clone .m3
  1180.     .m1 clone .m4
  1181.     list [catch {destroy .m2} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
  1182. } {0 {} 0 {}}
  1183. test menu-6.12 {TkDestroyMenu} {
  1184.     catch {destroy .m1}
  1185.     catch {destroy .m2}
  1186.     catch {destroy .m3}
  1187.     catch {destroy .m4}
  1188.     menu .m1
  1189.     .m1 clone .m2
  1190.     .m1 clone .m3
  1191.     .m1 clone .m4
  1192.     list [catch {destroy .m3} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
  1193. } {0 {} 0 {}}
  1194. test menu-6.13 {TkDestroyMenu} {
  1195.     catch {destroy .m1}
  1196.     catch {destroy .m2}
  1197.     catch {destroy .m3}
  1198.     catch {destroy .m4}
  1199.     menu .m1
  1200.     .m1 clone .m2
  1201.     .m1 clone .m3
  1202.     .m1 clone .m4
  1203.     list [catch {destroy .m4} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
  1204. } {0 {} 0 {}}
  1205. test menu-6.14 {TkDestroyMenu} {
  1206.     catch {destroy .m1}
  1207.     menu .m1
  1208.     . configure -menu .m1
  1209.     list [catch {destroy .m1} msg] $msg [. configure -menu ""]
  1210. } {0 {} {}}
  1211. test menu-6.15 {TkDestroyMenu} {
  1212.     catch {destroy .m1}
  1213.     catch {destroy .t2}
  1214.     menu .m1
  1215.     toplevel .t2
  1216.     wm geometry .t2 +0+0
  1217.     . configure -menu .m1
  1218.     .t2 configure -menu .m1
  1219.     list [catch {destroy .m1} msg] $msg [destroy .t2] [. configure -menu ""]
  1220. } {0 {} {} {}}
  1221. test menu-6.16 {TkDestroyMenu} {
  1222.     catch {destroy .m1}
  1223.     catch {destroy .t2}
  1224.     catch {destroy .t3}
  1225.     menu .m1
  1226.     toplevel .t2
  1227.     wm geometry .t2 +0+0
  1228.     toplevel .t3
  1229.     wm geometry .t3 +0+0
  1230.     . configure -menu .m1
  1231.     .t2 configure -menu .m1
  1232.     .t3 configure -menu .m1
  1233.     list [catch {destroy .m1} msg] $msg [destroy .t2] [destroy .t3] [. configure -menu ""]
  1234. } {0 {} {} {} {}}
  1235.  
  1236. test menu-7.1 {UnhookCascadeEntry} {
  1237.     catch {destroy .m1}
  1238.     menu .m1
  1239.     .m1 add command -label "test"
  1240.     list [catch {destroy .m1} msg] $msg
  1241. } {0 {}}
  1242. test menu-7.2 {UnhookCascadeEntry} {
  1243.     catch {destroy .m1}
  1244.     menu .m1
  1245.     .m1 add cascade -menu .m2
  1246.     list [catch {destroy .m1} msg] $msg
  1247. } {0 {}}
  1248. test menu-7.3 {UnhookCascadeEntry} {
  1249.     catch {destroy .m1}
  1250.     catch {destroy .m2}
  1251.     menu .m1
  1252.     menu .m2
  1253.     .m2 add cascade -menu .cascade
  1254.     .m1 add cascade -menu .cascade
  1255.     list [catch {destroy .m1} msg] $msg [destroy .m2]
  1256. } {0 {} {}}
  1257. test menu-7.4 {UnhookCascadeEntry} {
  1258.     catch {destroy .m1}
  1259.     catch {destroy .m2}
  1260.     menu .m1
  1261.     menu .m2
  1262.     .m1 add cascade -menu .cascade
  1263.     .m2 add cascade -menu .cascade
  1264.     list [catch {destroy .m1} msg] $msg [destroy .m2]
  1265. } {0 {} {}}
  1266. test menu-7.5 {UnhookCascadeEntry} {
  1267.     catch {destroy .m1}
  1268.     catch {destroy .m2}
  1269.     catch {destroy .m3}
  1270.     menu .m1
  1271.     menu .m2
  1272.     menu .m3
  1273.     .m1 add cascade -menu .cascade
  1274.     .m2 add cascade -menu .cascade
  1275.     .m3 add cascade -menu .cascade
  1276.     list [catch {destroy .m1} msg] $msg [destroy .m2 .m3]
  1277. } {0 {} {}}
  1278. test menu-7.6 {UnhookCascadeEntry} {
  1279.     catch {destroy .m1}
  1280.     catch {destroy .m2}
  1281.     catch {destroy .m3}
  1282.     menu .m1
  1283.     menu .m2
  1284.     menu .m3
  1285.     .m1 add cascade -menu .cascade
  1286.     .m2 add cascade -menu .cascade
  1287.     .m3 add cascade -menu .cascade
  1288.     list [catch {destroy .m2} msg] $msg [destroy .m1 .m3]
  1289. } {0 {} {}}
  1290. test menu-7.7 {UnhookCascadeEntry} {
  1291.     catch {destroy .m1}
  1292.     catch {destroy .m2}
  1293.     catch {destroy .m3}
  1294.     menu .m1
  1295.     menu .m2
  1296.     menu .m3
  1297.     .m1 add cascade -menu .cascade
  1298.     .m2 add cascade -menu .cascade
  1299.     .m3 add cascade -menu .cascade
  1300.     list [catch {destroy .m3} msg] $msg [destroy .m1 .m2]
  1301. } {0 {} {}}
  1302. test menu-7.8 {UnhookCascadeEntry} {
  1303.     catch {destroy .m1}
  1304.     catch {destroy .m2}
  1305.     menu .m1
  1306.     menu .m2
  1307.     .m1 add cascade -menu .m2
  1308.     list [catch {destroy .m1} msg] $msg [destroy .m2]
  1309. } {0 {} {}}
  1310. test menu-7.9 {UnhookCascadeEntry} {
  1311.     catch {destroy .m1}
  1312.     catch {destroy .m2}
  1313.     menu .m1
  1314.     menu .m2
  1315.     .m1 add cascade -menu .m2
  1316.     destroy .m1
  1317.     list [catch {destroy .m2} msg] $msg
  1318. } {0 {}}
  1319.  
  1320. test menu-8.1 {DestroyMenuEntry} {
  1321.     catch {destroy .m1}
  1322.     catch {destroy .m2}
  1323.     menu .m1
  1324.     menu .m2
  1325.     .m1 add cascade -menu .m2
  1326.     list [catch {.m1 delete 1} msg] $msg [destroy .m1 .m2]
  1327. } {0 {} {}}
  1328. test menu-8.2 {DestroyMenuEntry} {
  1329.     catch {image delete image1a}
  1330.     catch {destroy .m1}
  1331.     image create photo image1a -file [file join $tk_library demos images earth.gif]
  1332.     menu .m1
  1333.     .m1 add command -image image1a
  1334.     list [catch {.m1 delete 1} msg] $msg [destroy .m1] [image delete image1a]
  1335. } {0 {} {} {}}
  1336. test menu-8.3 {DestroyMenuEntry} {
  1337.     catch {eval image delete [image names]}
  1338.     catch {destroy .m1}
  1339.     image create test image1
  1340.     image create test image2
  1341.     menu .m1
  1342.     .m1 add checkbutton -image image1 -selectimage image2
  1343.     .m1 invoke 1
  1344.     list [catch {.m1 delete 1} msg] $msg [destroy .m1] [eval image delete [image names]]
  1345. } {0 {} {} {}}
  1346. test menu-8.4 {DestroyMenuEntry} {
  1347.     catch {destroy .m1}
  1348.     menu .m1
  1349.     .m1 add checkbutton -variable foo
  1350.     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
  1351. } {0 {} {}} 
  1352. test menu-8.5 {DestroyMenuEntry} {
  1353.     catch {destroy .m1}
  1354.     menu .m1
  1355.     .m1 add command -label "test"
  1356.     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
  1357. } {0 {} {}}
  1358. test menu-8.6 {DestroyMenuEntry} {
  1359.     catch {destroy .m1}
  1360.     menu .m1
  1361.     .m1 add command -label "one"
  1362.     .m1 add command -label "two"
  1363.     list [catch {.m1 delete 1} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
  1364. } {0 {} two {}}
  1365. test menu-8.7 {DestroyMenuEntry} {
  1366.     catch {destroy .m1}
  1367.     catch {destroy .m2}
  1368.     menu .m1
  1369.     .m1 add command -label "one"
  1370.     .m1 clone .m2 tearoff
  1371.     list [catch {.m2 delete 0} msg] $msg [destroy .m1]
  1372. } {0 {} {}}
  1373.  
  1374. # test menu-9 - Can only change when fonts change on system, which cannot
  1375. # be done from tcl.
  1376.  
  1377. test menu-9.1 {ConfigureMenu} {
  1378.     catch {destroy .m1}
  1379.     menu .m1
  1380.     list [catch {.m1 configure -postcommand "beep"} msg] $msg [.m1 cget -postcommand] [destroy .m1]    
  1381. } {0 {} beep {}}
  1382. test menu-9.2 {ConfigureMenu} {
  1383.     catch {destroy .m1}
  1384.     menu .m1
  1385.     .m1 add command -label "test"
  1386.     list [catch {.m1 configure -tearoff 0} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
  1387. } {0 {} test {}}
  1388. test menu-9.3 {ConfigureMenu} {
  1389.     catch {destroy .m1}
  1390.     menu .m1
  1391.     list [catch {.m1 configure -postcommand "beep"} msg] $msg [.m1 cget -postcommand] [destroy .m1]
  1392. } {0 {} beep {}}
  1393. test menu-9.4 {ConfigureMenu} {
  1394.     catch {destroy .m1}
  1395.     menu .m1
  1396.     .m1 add command -label "test"
  1397.     list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
  1398. } {0 {} {}}
  1399. test menu-9.5 {ConfigureMenu} {
  1400.     catch {destroy .m1}
  1401.     menu .m1
  1402.     .m1 add command -label "test"
  1403.     .m1 add command -label "two"
  1404.     list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
  1405. } {0 {} {}}
  1406. test menu-9.6 {ConfigureMenu} {
  1407.     catch {destroy .m1}
  1408.     menu .m1
  1409.     .m1 add command -label "test"
  1410.     .m1 add command -label "two"
  1411.     .m1 add command -label "three"
  1412.     list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
  1413. } {0 {} {}}
  1414. test menu-9.7 {ConfigureMenu} {
  1415.     catch {destroy .m1}
  1416.     catch {destroy .m2}
  1417.     menu .m1
  1418.     .m1 clone .m2 tearoff
  1419.     list [catch {.m1 configure -fg red} msg] $msg [.m2 cget -fg] [destroy .m1]
  1420. } {0 {} red {}}
  1421. test menu-9.8 {ConfigureMenu} {
  1422.     catch {destroy .m1}
  1423.     catch {destroy .m2}
  1424.     menu .m1
  1425.     .m1 clone .m2 tearoff
  1426.     list [catch {.m2 configure -fg red} msg] $msg [.m1 cget -fg] [destroy .m1]
  1427. } {0 {} red {}}
  1428. test menu-9.9 {ConfigureMenu} {
  1429.     catch {destroy .m1}
  1430.     menu .m1
  1431.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  1432. } {0 {} {} {}}
  1433.  
  1434. test menu-10.1 {ConfigureMenuEntry} {
  1435.     catch {destroy .m1}
  1436.     catch {unset foo}
  1437.     menu .m1
  1438.     .m1 add checkbutton -variable foo -onvalue on -offvalue off -label "Nonsense"
  1439.     list [catch {.m1 entryconfigure 1 -variable bar} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
  1440. } {0 {} bar {}}
  1441. test menu-10.2 {ConfigureMenuEntry} {
  1442.     catch {destroy .m1}
  1443.     menu .m1
  1444.     .m1 add command -label "test"
  1445.     list [catch {.m1 entryconfigure 1 -label ""} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
  1446. } {0 {} {} {}}
  1447. test menu-10.3 {ConfigureMenuEntry} {
  1448.     catch {destroy .m1}
  1449.     menu .m1
  1450.     .m1 add command
  1451.     list [catch {.m1 entryconfigure 1 -label "test"} cmd] $cmd [.m1 entrycget 1 -label] [destroy .m1]
  1452. } {0 {} test {}}
  1453. test menu-10.4 {ConfigureMenuEntry} {
  1454.     catch {destroy .m1}
  1455.     menu .m1 
  1456.     .m1 add command
  1457.     list [catch {.m1 entryconfigure 1 -accel "S"} msg] $msg [.m1 entrycget 1 -accel] [destroy .m1]
  1458. } {0 {} S {}}
  1459. test menu-10.5 {ConfigureMenuEntry} {
  1460.     catch {destroy .m1}
  1461.     menu .m1
  1462.     .m1 add command
  1463.     list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
  1464. } {0 {} test {}}
  1465. test menu-10.6 {ConfigureMenuEntry} {
  1466.     catch {destroy .m1}
  1467.     menu .m1
  1468.     .m1 add command
  1469.     list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [destroy .m1]
  1470. } {0 {} {}}
  1471. test menu-10.7 {ConfigureMenuEntry} {
  1472.     catch {destroy .m1}
  1473.     catch {destroy .m2}
  1474.     menu .m2
  1475.     menu .m1
  1476.     .m1 add cascade
  1477.     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1 .m2]
  1478. } {0 {} {}}
  1479. test menu-10.8 {ConfigureMenuEntry} {
  1480.     catch {destroy .m1}
  1481.     menu .m1
  1482.     .m1 add cascade
  1483.     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
  1484. } {0 {} {}}
  1485. test menu-10.9 {ConfigureMenuEntry} {
  1486.     catch {destroy .m1}
  1487.     menu .m1
  1488.     .m1 add cascade -menu .m3
  1489.     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
  1490. } {0 {} {}}
  1491. test menu-10.10 {ConfigureMenuEntry} {
  1492.     catch {destroy .m1}
  1493.     menu .m1
  1494.     .m1 add cascade
  1495.     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
  1496. } {0 {} {}}
  1497. test menu-10.11 {ConfigureMenuEntry} {
  1498.     catch {destroy .m1}
  1499.     menu .m1
  1500.     .m1 add cascade -menu .m2
  1501.     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
  1502. } {0 {} {}}
  1503. test menu-10.12 {ConfigureMenuEntry} {
  1504.     catch {destroy .m1}
  1505.     catch {destroy .m2}
  1506.     catch {destroy .m3}
  1507.     catch {destroy .m4}
  1508.     catch {destroy .m5}
  1509.     menu .m1
  1510.     menu .m2 
  1511.     .m2 add cascade -menu .m1
  1512.     menu .m3 
  1513.     .m3 add cascade -menu .m1
  1514.     menu .m4 
  1515.     .m4 add cascade -menu .m1
  1516.     menu .m5 
  1517.     .m5 add cascade
  1518.     list [catch {.m5 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4 .m5]
  1519. } {0 {} {}}
  1520. test menu-10.13 {ConfigureMenuEntry} {
  1521.     catch {destroy .m1}
  1522.     catch {destroy .m2}
  1523.     catch {destroy .m3}
  1524.     catch {destroy .m4}
  1525.     menu .m1
  1526.     menu .m2 
  1527.     .m2 add cascade -menu .m1
  1528.     menu .m3 
  1529.     .m3 add cascade -menu .m1
  1530.     menu .m4 
  1531.     .m4 add cascade -menu .m1
  1532.     list [catch {.m3 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4]
  1533. } {0 {} {}}
  1534. test menu-10.14 {ConfigureMenuEntry} {
  1535.     catch {destroy .m1}
  1536.     menu .m1
  1537.     .m1 add checkbutton
  1538.     list [catch {.m1 entryconfigure 1 -variable "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
  1539. } {0 {} test {}}
  1540. test menu-10.15 {ConfigureMenuEntry} {
  1541.     catch {destroy .m1}
  1542.     menu .m1
  1543.     list [catch {.m1 add checkbutton -label "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
  1544. } {0 {} test {}}
  1545. test menu-10.16 {ConfigureMenuEntry} {
  1546.     catch {destroy .m1}
  1547.     menu .m1
  1548.     list [catch {.m1 add radiobutton -label "test"} msg] $msg [destroy .m1]
  1549. } {0 {} {}}
  1550. test menu-10.17 {ConfigureMenuEntry} {
  1551.     catch {destroy .m1}
  1552.     menu .m1
  1553.     .m1 add checkbutton
  1554.     list [catch {.m1 entryconfigure 1 -onvalue "test"} msg] $msg [.m1 entrycget 1 -onvalue] [destroy .m1]
  1555. } {0 {} test {}}
  1556. test menu-10.18 {ConfigureMenuEntry} {
  1557.     catch {destroy .m1}
  1558.     catch {image delete image1}
  1559.     menu .m1
  1560.     .m1 add command
  1561.     image create test image1
  1562.     list [catch {.m1 entryconfigure 1 -image image1} msg] $msg [destroy .m1] [image delete image1]
  1563. } {0 {} {} {}}
  1564. test menu-10.19 {ConfigureMenuEntry} {
  1565.     catch {destroy .m1}
  1566.     catch {image delete image1}
  1567.     catch {image delete image2}
  1568.     image create test image1
  1569.     image create photo image2 -file [file join $tk_library demos images earth.gif]
  1570.     menu .m1
  1571.     .m1 add command -image image1
  1572.     list [catch {.m1 entryconfigure 1 -image image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
  1573. } {0 {} {} {} {}}
  1574. test menu-10.20 {ConfigureMenuEntry} {
  1575.     catch {destroy .m1}
  1576.     catch {image delete image1}
  1577.     catch {image delete image2}
  1578.     image create photo image1 -file [file join $tk_library demos images earth.gif]
  1579.     image create test image2
  1580.     menu .m1
  1581.     .m1 add checkbutton -image image1
  1582.     list [catch {.m1 entryconfigure 1 -selectimage image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
  1583. } {0 {} {} {} {}}
  1584. test menu-10.21 {ConfigureMenuEntry} {
  1585.     catch {destroy .m1}
  1586.     catch {image delete image1}
  1587.     catch {image delete image2}
  1588.     catch {image delete image3}
  1589.     image create photo image1 -file [file join $tk_library demos images earth.gif]
  1590.     image create test image2
  1591.     image create test image3
  1592.     menu .m1
  1593.     .m1 add checkbutton -image image1 -selectimage image2
  1594.     list [catch {.m1 entryconfigure 1 -selectimage image3} msg] $msg [destroy .m1] [image delete image1] [image delete image2] [image delete image3]
  1595. } {0 {} {} {} {} {}}
  1596.  
  1597. test menu-11.1 {ConfigureMenuCloneEntries} {
  1598.     catch {destroy .m1}
  1599.     catch {destroy .m2}
  1600.     catch {destroy .m3}
  1601.     menu .m1
  1602.     .m1 clone .m2
  1603.     .m2 configure -tearoff 0
  1604.     .m1 clone .m3
  1605.     .m1 add command -label "test"
  1606.     .m1 add command -label "test2"
  1607.     list [list [catch {.m1 entryconfigure 1 -gork "foo"} msg] $msg] [destroy .m1]
  1608. } {{1 {unknown option "-gork"}} {}}
  1609. test menu-11.2 {ConfigureMenuCloneEntries} {
  1610.     catch {destroy .m1}
  1611.     catch {destroy .m2}
  1612.     catch {destroy .m3}
  1613.     catch {destroy .m4}
  1614.     menu .m1
  1615.     .m1 clone .m2
  1616.     menu .m3
  1617.     .m1 add cascade -menu .m3
  1618.     menu .m4
  1619.     list [catch {.m1 entryconfigure 1 -menu .m4} msg] $msg [destroy .m1] [destroy .m3] [destroy .m4]
  1620. } {0 {} {} {} {}}
  1621. test menu-11.3 {ConfigureMenuCloneEntries} {
  1622.     catch {destroy .m1}
  1623.     catch {destroy .m2}
  1624.     menu .m1
  1625.     .m1 clone .m2
  1626.     .m1 add cascade -label dummy
  1627.     list [catch {.m1 entryconfigure dummy -menu .m3} msg] $msg [destroy .m1]
  1628. } {0 {} {}}
  1629.  
  1630. test menu-12.1 {TkGetMenuIndex} {
  1631.     catch {destroy .m1}
  1632.     menu .m1
  1633.     .m1 add command -label "active"
  1634.     .m1 add command -label "test2"
  1635.     .m1 add command -label "test3"
  1636.     .m1 activate 2
  1637.     list [catch {.m1 entrycget active -label} msg] $msg [destroy .m1]
  1638. } {0 test2 {}}
  1639. test menu-12.2 {TkGetMenuIndex} {
  1640.     catch {destroy .m1}
  1641.     menu .m1
  1642.     .m1 add command -label "last"
  1643.     .m1 add command -label "test2"
  1644.     .m1 add command -label "test3"
  1645.     .m1 activate 2
  1646.     list [catch {.m1 entrycget last -label} msg] $msg [destroy .m1]
  1647. } {0 test3 {}}
  1648. test menu-12.3 {TkGetMenuIndex} {
  1649.     catch {destroy .m1}
  1650.     menu .m1
  1651.     .m1 add command -label "last"
  1652.     .m1 add command -label "test2"
  1653.     .m1 add command -label "test3"
  1654.     .m1 activate 2
  1655.     list [catch {.m1 entrycget end -label} msg] $msg [destroy .m1]
  1656. } {0 test3 {}}
  1657. test menu-12.4 {TkGetMenuIndex} {
  1658.     catch {destroy .m1}
  1659.     menu .m1
  1660.     .m1 add command -label "test"
  1661.     list [catch {.m1 insert last command -label "test2"} msg] $msg [.m1 entrycget last -label] [destroy .m1]
  1662. } {0 {} test2 {}}
  1663. test menu-12.5 {TkGetMenuIndex} {
  1664.     catch {destroy .m1}
  1665.     menu .m1
  1666.     .m1 add command -label "test"
  1667.     list [catch {.m1 insert end command -label "test2"} msg] $msg [.m1 entrycget end -label] [destroy .m1]
  1668. } {0 {} test2 {}}
  1669. test menu-12.6 {TkGetMenuIndex} {
  1670.     catch {destroy .m1}
  1671.     menu .m1
  1672.     .m1 add command -label "active"
  1673.     .m1 add command -label "test2"
  1674.     .m1 add command -label "test3"
  1675.     .m1 activate 2
  1676.     list [catch {.m1 entrycget none -label} msg] $msg [destroy .m1]
  1677. } {0 {} {}}
  1678. #test menu-13.7 - Need to add @test here.
  1679. test menu-12.7 {TkGetMenuIndex} {
  1680.     catch {destroy .m1}
  1681.     menu .m1
  1682.     .m1 add command -label "active"
  1683.     .m1 add command -label "test2"
  1684.     .m1 add command -label "test3"
  1685.     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
  1686. } {0 active {}}
  1687. test menu-12.8 {TkGetMenuIndex} {
  1688.     catch {destroy .m1}
  1689.     menu .m1
  1690.     .m1 add command -label "active"
  1691.     list [catch {.m1 entrycget -1 -label} msg] $msg [destroy .m1]
  1692. } {1 {bad menu entry index "-1"} {}}
  1693. test menu-12.9 {TkGetMenuIndex} {
  1694.     catch {destroy .m1}
  1695.     menu .m1
  1696.     .m1 add command -label "test"
  1697.     .m1 add command -label "test2"
  1698.     list [catch {.m1 entrycget 999 -label} msg] $msg [destroy .m1]
  1699. } {0 test2 {}}
  1700. test menu-12.10 {TkGetMenuIndex} {
  1701.     catch {destroy .m1}
  1702.     menu .m1
  1703.     .m1 insert 999 command -label "test"
  1704.     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
  1705. } {0 test {}}
  1706. test menu-12.11 {TkGetMenuIndex} {
  1707.     catch {destroy .m1}
  1708.     menu .m1
  1709.     .m1 add command -label "1test"
  1710.     list [catch {.m1 entrycget 1test -label} msg] $msg [destroy .m1]
  1711. } {0 1test {}}
  1712. test menu-12.12 {TkGetMenuIndex} {
  1713.     catch {destroy .m1}
  1714.     menu .m1
  1715.     .m1 add command -label "test"
  1716.     .m1 add command -label "test2" -command "beep"
  1717.     .m1 add command -label "test3"
  1718.     list [catch {.m1 entrycget test2 -command} msg] $msg [destroy .m1]
  1719. } {0 beep {}}
  1720.  
  1721. test menu-13.1 {MenuCmdDeletedProc} {
  1722.     catch {destroy .m1}
  1723.     menu .m1
  1724.     list [catch {destroy .m1} msg] $msg
  1725. } {0 {}}
  1726. test menu-13.2 {MenuCmdDeletedProc} {
  1727.     catch {destroy .m1}
  1728.     menu .m1
  1729.     .m1 clone .m2
  1730.     list [catch {destroy .m1} msg] $msg
  1731. } {0 {}}
  1732.  
  1733. test menu-14.1 {MenuNewEntry} {
  1734.     catch {destroy .m1}
  1735.     menu .m1
  1736.     list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
  1737. } {0 {} {}}
  1738. test menu-14.2 {MenuNewEntry} {
  1739.     catch {destroy .m1}
  1740.     menu .m1
  1741.     .m1 add command -label "test"
  1742.     .m1 add command -label "test3"
  1743.     list [catch {.m1 insert 2 command -label "test2"} msg] $msg [destroy .m1]
  1744. } {0 {} {}}
  1745. test menu-14.3 {MenuNewEntry} {
  1746.     catch {destroy .m1}
  1747.     menu .m1
  1748.     .m1 add command -label "test"
  1749.     list [catch {.m1 add command -label "test2"} msg] $msg [destroy .m1]
  1750. } {0 {} {}}
  1751. test menu-14.4 {MenuNewEntry} {
  1752.     catch {destroy .m1}
  1753.     menu .m1
  1754.     list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
  1755. } {0 {} {}}
  1756.  
  1757. test menu-15.1 {MenuAddOrInsert} {
  1758.     catch {destroy .m1}
  1759.     menu .m1
  1760.     list [catch {.m1 insert foo command -label "test"} msg] $msg [destroy .m1]
  1761. } {1 {bad menu entry index "foo"} {}}
  1762. test menu-15.2 {MenuAddOrInsert} {
  1763.     catch {destroy .m1}
  1764.     menu .m1
  1765.     .m1 add command -label "test"
  1766.     list [catch {.m1 insert test command -label "foo"} msg] $msg [destroy .m1]
  1767. } {0 {} {}}
  1768. test menu-15.3 {MenuAddOrInsert} {
  1769.     catch {destroy .m1}
  1770.     menu .m1
  1771.     list [catch {.m1 insert -1 command -label "test"} msg] $msg [destroy .m1]
  1772. } {1 {bad menu entry index "-1"} {}}
  1773. test menu-15.4 {MenuAddOrInsert} {
  1774.     catch {destroy .m1}
  1775.     menu .m1
  1776.     .m1 add command -label "test"
  1777.     .m1 insert 0 command -label "test2"
  1778.     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
  1779. } {0 test2 {}}
  1780. test menu-15.5 {MenuAddOrInsert} {
  1781.     catch {destroy .m1}
  1782.     menu .m1
  1783.     list [catch {.m1 add cascade} msg] $msg [destroy .m1]
  1784. } {0 {} {}}
  1785. test menu-15.6 {MenuAddOrInsert} {
  1786.     catch {destroy .m1}
  1787.     menu .m1
  1788.     list [catch {.m1 add checkbutton} msg] $msg [destroy .m1]
  1789. } {0 {} {}}
  1790. test menu-15.7 {MenuAddOrInsert} {
  1791.     catch {destroy .m1}
  1792.     menu .m1
  1793.     list [catch {.m1 add command} msg] $msg [destroy .m1]
  1794. } {0 {} {}}
  1795. test menu-15.8 {MenuAddOrInsert} {
  1796.     catch {destroy .m1}
  1797.     menu .m1
  1798.     list [catch {.m1 add radiobutton} msg] $msg [destroy .m1]
  1799. } {0 {} {}}
  1800. test menu-15.9 {MenuAddOrInsert} {
  1801.     catch {destroy .m1}
  1802.     menu .m1
  1803.     list [catch {.m1 add separator} msg] $msg [destroy .m1]
  1804. } {0 {} {}}
  1805. test menu-15.10 {MenuAddOrInsert} {
  1806.     catch {destroy .m1}
  1807.     menu .m1
  1808.     list [catch {.m1 add blork} msg] $msg [destroy .m1]
  1809. } {1 {bad menu entry type "blork": must be cascade, checkbutton, command, radiobutton, or separator} {}}
  1810. test menu-15.11 {MenuAddOrInsert} {
  1811.     catch {destroy .m1}
  1812.     menu .m1
  1813.     list [catch {.m1 add command} msg] $msg [destroy .m1]
  1814. } {0 {} {}}
  1815. test menu-15.12 {MenuAddOrInsert} {
  1816.     catch {destroy .m1}
  1817.     catch {destroy .m2}
  1818.     catch {destroy .m3}
  1819.     menu .m1
  1820.     .m1 clone .m2
  1821.     .m2 clone .m3
  1822.     list [catch {.m2 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m3 entrycget 1 -label} msg3] $msg3 [destroy .m1]
  1823. } {0 {} 0 test 0 test {}}
  1824. test menu-15.13 {MenuAddOrInsert} {
  1825.     catch {destroy .m1}
  1826.     catch {destroy .m2}
  1827.     catch {destroy .m3}
  1828.     menu .m1
  1829.     .m1 clone .m2
  1830.     .m2 clone .m3
  1831.     list [catch {.m3 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m2 entrycget 1 -label} msg3] $msg3 [destroy .m1]
  1832. } {0 {} 0 test 0 test {}}
  1833. test menu-15.14 {MenuAddOrInsert} {
  1834.     catch {destroy .m1}
  1835.     menu .m1
  1836.     list [catch {.m1 add command -blork} msg] $msg [destroy .m1]
  1837. } {1 {unknown option "-blork"} {}}
  1838. test menu-15.15 {MenuAddOrInsert} {
  1839.     catch {destroy .m1}
  1840.     catch {destroy .container}
  1841.     menu .m1
  1842.     .m1 add command -label "File"
  1843.     menu .container
  1844.     . configure -menu .container
  1845.     list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .container .m1]
  1846. } {0 {} {} {}}
  1847. test menu-15.16 {MenuAddOrInsert} {
  1848.     catch {destroy .m1}
  1849.     catch {destroy .m2}
  1850.     menu .m1
  1851.     menu .m2
  1852.     set tearoff [tkTearOffMenu .m2]
  1853.     list [catch {.m2 add cascade -menu .m1} msg] $msg [$tearoff unpost] [catch {destroy .m1} msg2] $msg2 [catch {destroy .m2} msg3] $msg3
  1854. } {0 {} {} 0 {} 0 {}}
  1855. test menu-15.17 {MenuAddOrInsert} {
  1856.     catch {destroy .m1}
  1857.     catch {destroy .container}
  1858.     menu .m1
  1859.     menu .container
  1860.     . configure -menu .container
  1861.     set tearoff [tkTearOffMenu .container]
  1862.     list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
  1863. } {0 {} {} {}}
  1864. test menu-15.18 {MenuAddOrInsert} {
  1865.     catch {destroy .m1}
  1866.     catch {destroy .container}
  1867.     menu .m1
  1868.     menu .container
  1869.     .container add cascade -menu .m1
  1870.     . configure -menu .container
  1871.     list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
  1872. } {0 {} {} {}}
  1873. test menu-15.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
  1874.     catch {destroy .menubar}
  1875.     menu .menubar
  1876.     menu .menubar.test -tearoff 0
  1877.     .menubar add cascade -label Test -underline 0 -menu .menubar.test
  1878.     menu .menubar.test.cascade -tearoff 0
  1879.     .menubar.test.cascade add command -label SubItem -command "puts SubItemSelected"
  1880.     . configure -menu .menubar
  1881.     list [catch {.menubar.test add cascade -label SubMenu \
  1882.     -menu .menubar.test.cascade} msg] \
  1883.     [info commands .\#menubar.\#menubar\#test.\#menubar\#test\#cascade] \
  1884.     [. configure -menu ""] [destroy .menubar]
  1885. } {0 .#menubar.#menubar#test.#menubar#test#cascade {} {}}
  1886.  
  1887. test menu-16.1 {MenuVarProc} {
  1888.     catch {destroy .m1}
  1889.     catch {unset foo}
  1890.     menu .m1
  1891.     set foo "hello"
  1892.     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [catch {unset foo} msg2] $msg2 [destroy .m1]
  1893. } {0 {} 0 {} {}}
  1894. # menu-17.2 - Don't know how to generate the flags in the if
  1895. test menu-16.2 {MenuVarProc} {
  1896.     catch {destroy .m1}
  1897.     catch {unset foo}
  1898.     menu .m1
  1899.     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo ""] [destroy .m1]
  1900. } {0 {} {} {}}
  1901. test menu-16.3 {MenuVarProc} {
  1902.     catch {destroy .m1}
  1903.     catch {unset foo}
  1904.     menu .m1
  1905.     set foo "hello"
  1906.     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
  1907. } {0 {} hello {} 0 {}}
  1908. test menu-16.4 {MenuVarProc} {
  1909.     catch {destroy .m1}
  1910.     menu .m1
  1911.     set foo "goodbye"
  1912.     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
  1913. } {0 {} hello {} 0 {}}
  1914. test menu-16.5 {MenuVarProc} {
  1915.     catch {destroy .m1}
  1916.     menu .m1
  1917.     set foo "hello"
  1918.     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "goodbye"] [destroy .m1] [catch {unset foo} msg2] $msg2
  1919. } {0 {} goodbye {} 0 {}}
  1920.  
  1921. test menu-17.1 {TkActivateMenuEntry} {
  1922.     catch {destroy .m1}
  1923.     menu .m1
  1924.     .m1 add command -label "test"
  1925.     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
  1926. } {0 {} {}}
  1927. test menu-17.2 {TkActivateMenuEntry} {
  1928.     catch {destroy .m1}
  1929.     menu .m1
  1930.     .m1 add command -label "test"
  1931.     list [catch {.m1 activate 0} msg] $msg [destroy .m1]
  1932. } {0 {} {}}
  1933. test menu-17.3 {TkActivateMenuEntry} {
  1934.     catch {destroy .m1}
  1935.     menu .m1
  1936.     .m1 add command -label "test"
  1937.     .m1 add command -label "test2"
  1938.     .m1 activate 1
  1939.     list [catch {.m1 activate 2} msg] $msg [destroy .m1]
  1940. } {0 {} {}}
  1941. test menu-17.4 {TkActivateMenuEntry} {
  1942.     catch {destroy .m1}
  1943.     menu .m1
  1944.     .m1 add command -label "test"
  1945.     .m1 add command -label "test2"
  1946.     .m1 activate 1
  1947.     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
  1948. } {0 {} {}}
  1949.  
  1950. test menu-18.1 {TkPostCommand} {menuInteractive} {
  1951.     catch {destroy .m1}
  1952.     menu .m1 -postcommand "set menu_test menu-19.1"
  1953.     .m1 add command -label "menu-19.1 - hit Escape"
  1954.     list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [set menu_test] [destroy .m1]
  1955. } {0 menu-19.1 {} menu-19.1 {}}
  1956. test menu-18.2 {TkPostCommand} {menuInteractive} {
  1957.     catch {destroy .m1}
  1958.     menu .m1
  1959.     .m1 add command -label "menu-19.2 - hit Escape"
  1960.     list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [destroy .m1]
  1961. } {0 {} {} {}}
  1962.  
  1963. test menu-19.1 {CloneMenu} {
  1964.     catch {destroy .m1}
  1965.     catch {destroy .m2}
  1966.     menu .m1
  1967.     list [catch {.m1 clone .m2} msg1] $msg1 [destroy .m1]
  1968. } {0 {} {}}
  1969. test menu-19.2 {CloneMenu} {
  1970.     catch {destroy .m1}
  1971.     catch {destroy .m2}
  1972.     menu .m1
  1973.     list [catch {.m1 clone .m2 normal} msg1] $msg1 [destroy .m1]
  1974. } {0 {} {}}
  1975. test menu-19.3 {CloneMenu} {
  1976.     catch {destroy .m1}
  1977.     catch {destroy .m2}
  1978.     menu .m1
  1979.     list [catch {.m1 clone .m2 tearoff} msg1] $msg1 [destroy .m1]
  1980. } {0 {} {}}
  1981. test menu-19.4 {CloneMenu} {
  1982.     catch {destroy .m1}
  1983.     catch {destroy .m2}
  1984.     menu .m1
  1985.     list [catch {.m1 clone .m2 menubar} msg1] $msg1 [destroy .m1]
  1986. } {0 {} {}}
  1987. test menu-19.5 {CloneMenu} {
  1988.     catch {destroy .m1}
  1989.     catch {destroy .m2}
  1990.     menu .m1
  1991.     list [catch {.m1 clone .m2 foo} msg1] $msg1 [destroy .m1]
  1992. } {1 {bad menu type - must be normal, tearoff, or menubar} {}}
  1993. test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} {
  1994.     catch {destroy .m1}
  1995.     catch {destroy .m2}
  1996.     menu .m1
  1997.     list [catch {.m1 clone .m2} msg] $msg [destroy .m1]
  1998.  } {0 {} {}}
  1999.  test menu-19.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
  2000.     catch {destroy .m1}
  2001.     catch {destroy .m2}
  2002.     catch {destroy .m3}
  2003.     menu .m1
  2004.     .m1 clone .m2
  2005.     list [catch {.m1 clone .m3} msg] $msg [destroy .m1]
  2006.  } {0 {} {}}
  2007.  test menu-19.8 {CloneMenu - cascade entries} {
  2008.     catch {destroy .m1}
  2009.     catch {destroy .foo}
  2010.     menu .m1
  2011.     .m1 add cascade -menu .m2
  2012.     list [catch {.m1 clone .foo} msg] $msg [destroy .m1]
  2013.  } {0 {} {}}
  2014.  test menu-19.9 {CloneMenu - cascades entries} {
  2015.     catch {destroy .m1}
  2016.     catch {destroy .m2}
  2017.     catch {destroy .foo}
  2018.     menu .m1
  2019.     .m1 add cascade -menu .m2
  2020.     menu .m2
  2021.     list [catch {.m1 clone .foo} msg] $msg [destroy .m1 .m2]
  2022.  } {0 {} {}}
  2023. test menu-19.10 {CloneMenu - tearoff fields} {
  2024.     catch {destroy .m1}
  2025.     catch {destroy .m2}
  2026.     menu .m1
  2027.     list [catch {.m1 clone .m2 normal} msg1] $msg1 [catch {.m2 cget -tearoff} msg2] $msg2 [destroy .m1]
  2028. } {0 {} 0 1 {}}
  2029. test menu-19.11 {CloneMenu} {
  2030.     catch {destroy .m1}
  2031.     catch {destroy .m2}
  2032.     menu .m1
  2033.     menu .m2
  2034.     list [catch {.m1 clone .m2} msg] $msg [destroy .m1 .m2]
  2035. } {1 {window name "m2" already exists in parent} {}}
  2036.  
  2037. test menu-20.1 {MenuDoYPosition} {
  2038.     catch {destroy .m1}
  2039.     menu .m1
  2040.     list [catch {.m1 yposition glorp} msg] $msg [destroy .m1]
  2041. } {1 {bad menu entry index "glorp"} {}}
  2042. test menu-20.2 {MenuDoYPosition} {
  2043.     catch {destroy .m1}
  2044.     menu .m1
  2045.     .m1 add command -label "Test"
  2046.     list [catch {.m1 yposition 1}] [destroy .m1]
  2047. } {0 {}}
  2048.  
  2049. test menu-21.1 {GetIndexFromCoords} {
  2050.     catch {destroy .m1}
  2051.     menu .m1
  2052.     .m1 add command -label "test"
  2053.     .m1 configure -tearoff 0
  2054.     list [catch {.m1 index @5} msg] $msg [destroy .m1]
  2055. } {0 0 {}}
  2056. test menu-21.2 {GetIndexFromCoords} {
  2057.     catch {destroy .m1}
  2058.     menu .m1
  2059.     .m1 add command -label "test"
  2060.     .m1 configure -tearoff 0
  2061.     list [catch {.m1 index @5,5} msg] $msg [destroy .m1]
  2062. } {0 0 {}}
  2063.  
  2064. test menu-22.1 {RecursivelyDeleteMenu} {
  2065.     catch {destroy .m1}
  2066.     menu .m1
  2067.     . configure -menu .m1
  2068.     list [catch {. configure -menu ""} msg] $msg [destroy .m1]
  2069. } {0 {} {}}
  2070. test menu-22.2 {RecursivelyDeleteMenu} {
  2071.     catch {destroy .m1}
  2072.     catch {destroy .m2}
  2073.     menu .m2
  2074.     .m2 add command -label "test2"
  2075.     menu .m1
  2076.     .m1 add cascade -label "test1" -menu .m2
  2077.     . configure -menu .m1
  2078.     list [catch {. configure -menu ""} msg] $msg [destroy .m1 .m2]
  2079. } {0 {} {}}
  2080.  
  2081. test menu-23.1 {TkNewMenuName} {
  2082.     catch {destroy .m1}
  2083.     menu .m1
  2084.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  2085. } {0 {} {} {}}
  2086. test menu-23.2 {TkNewMenuName} {
  2087.     catch {destroy .m1}
  2088.     catch {destroy .m1\#0}
  2089.     menu .m1
  2090.     menu .m1\#0
  2091.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  2092. } {0 {} {} {}}
  2093. test menu-23.3 {TkNewMenuName} {
  2094.     catch {destroy .#m}
  2095.     menu .#m
  2096.     rename .#m hideme
  2097.     list [catch {. configure -menu [menu .m]} $msg] [. configure -menu ""] [destroy .#m] [destroy .m] [destroy hideme]
  2098. } {0 {} {} {} {}}
  2099.  
  2100. test menu-24.1 {TkSetWindowMenuBar} {
  2101.     . configure -menu ""
  2102.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
  2103. } {0 {} {}}
  2104. test menu-24.2 {TkSetWindowMenuBar} {
  2105.     . configure -menu ""
  2106.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
  2107. } {0 {} {}}
  2108. test menu-24.3 {TkSetWindowMenuBar} {
  2109.     . configure -menu ""
  2110.     catch {destroy .m1}
  2111.     menu .m1
  2112.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  2113. } {0 {} {} {}}
  2114. test menu-24.4 {TkSetWindowMenuBar} {
  2115.     catch {destroy .m1}
  2116.     catch {destroy .m2}
  2117.     . configure -menu ""
  2118.     menu .m1
  2119.     . configure -menu .m1
  2120.     menu .m2
  2121.     list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
  2122. } {0 {} {} {}}
  2123. test menu-24.5 {TkSetWindowMenuBar} {
  2124.     catch {destroy .m1}
  2125.     catch {destroy .m2}
  2126.     catch {destroy .m3}
  2127.     . configure -menu ""
  2128.     menu .m1
  2129.     . configure -menu .m1
  2130.     .m1 clone .m2
  2131.     menu .m3
  2132.     list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
  2133. } {0 {} {} {}}
  2134. test menu-24.6 {TkSetWindowMenuBar} {
  2135.     catch {destroy .m1}
  2136.     catch {destroy .m2}
  2137.     catch {destroy .m3}
  2138.     . configure -menu ""
  2139.     menu .m1
  2140.     .m1 clone .m2
  2141.     . configure -menu .m2
  2142.     menu .m3
  2143.     list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
  2144. } {0 {} {} {}}
  2145. test menu-24.7 {TkSetWindowMenuBar} {
  2146.     catch {destroy .m1}
  2147.     catch {destroy .m2}
  2148.     . configure -menu ""
  2149.     menu .m1
  2150.     menu .m2
  2151.     . configure -menu .m1
  2152.     toplevel .t2
  2153.     .t2 configure -menu .m1
  2154.     list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
  2155. } {0 {} {} {}}
  2156. test menu-24.8 {TkSetWindowMenuBar} {
  2157.     catch {destroy .m1}
  2158.     catch {destroy .m2}
  2159.     catch {destroy .t2}
  2160.     . configure -menu ""
  2161.     menu .m1
  2162.     menu .m2
  2163.     . configure -menu .m1
  2164.     toplevel .t2
  2165.     wm geometry .t2 +0+0
  2166.     .t2 configure -menu .m1
  2167.     list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
  2168. } {0 {} {} {}}
  2169. test menu-24.9 {TkSetWindowMenuBar} {
  2170.     catch {destroy .m1}
  2171.     catch {destroy .m2}
  2172.     catch {destroy .t2}
  2173.     catch {destroy .t3}
  2174.     . configure -menu ""
  2175.     menu .m1
  2176.     menu .m2
  2177.     . configure -menu .m1
  2178.     toplevel .t2 -menu .m1
  2179.     wm geometry .t2 +0+0
  2180.     toplevel .t3 -menu .m1
  2181.     wm geometry .t3 +0+0
  2182.     list [catch {.t3 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
  2183. } {0 {} {} {}}
  2184. test menu-24.10 {TkSetWindowMenuBar} {
  2185.     catch {destroy .m1}
  2186.     catch {destroy .m2}
  2187.     catch {destroy .t2}
  2188.     catch {destroy .t3}
  2189.     . configure -menu ""
  2190.     menu .m1
  2191.     menu .m2
  2192.     . configure -menu .m1
  2193.     toplevel .t2 -menu .m1
  2194.     wm geometry .t2 +0+0
  2195.     toplevel .t3 -menu .m1
  2196.     wm geometry .t3 +0+0
  2197.     list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
  2198. } {0 {} {} {}}
  2199. test menu-24.11 {TkSetWindowMenuBar} {
  2200.     catch {destroy .m1}
  2201.     catch {destroy .m2}
  2202.     catch {destroy .t2}
  2203.     catch {destroy .t3}
  2204.     . configure -menu ""
  2205.     menu .m1
  2206.     menu .m2
  2207.     . configure -menu .m1
  2208.     toplevel .t2 -menu .m1
  2209.     wm geometry .t2 +0+0
  2210.     toplevel .t3 -menu .m1
  2211.     wm geometry .t3 +0+0
  2212.     list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
  2213. } {0 {} {} {}}
  2214. test menu-24.12 {TkSetWindowMenuBar} {
  2215.     catch {destroy .m1}
  2216.     . configure -menu ""
  2217.     menu .m1
  2218.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  2219. } {0 {} {} {}}
  2220. test menu-24.13 {TkSetWindowMenuBar} {
  2221.     . configure -menu ""
  2222.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
  2223. } {0 {} {}}
  2224. test menu-24.14 {TkSetWindowMenuBar} {
  2225.     catch {destroy .m1}
  2226.     . configure -menu ""
  2227.     menu .m1
  2228.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  2229. } {0 {} {} {}}
  2230. test menu-24.15 {TkSetWindowMenuBar} {
  2231.     . configure -menu ""
  2232.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
  2233. } {0 {} {}}
  2234. test menu-24.16 {TkSetWindowMenuBar} {
  2235.     catch {destroy .m1}
  2236.     . configure -menu ""
  2237.     menu .m1
  2238.     . configure -menu .m1
  2239.     list [catch {toplevel .t2 -menu m1} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
  2240. } {0 .t2 {} {}}
  2241.  
  2242. test menu-25.1 {DestroyMenuHashTable} {
  2243.     catch {interp destroy testinterp}
  2244.     interp create testinterp
  2245.     load {} Tk testinterp
  2246.     interp eval testinterp {menu .m1}
  2247.     list [catch {interp delete testinterp} msg] $msg
  2248. } {0 {}}
  2249.  
  2250. test menu-26.1 {GetMenuHashTable} {
  2251.     catch {interp destroy testinterp}
  2252.     interp create testinterp
  2253.     load {} tk testinterp
  2254.     list [catch {interp eval testinterp {menu .m1}} msg] $msg [interp delete testinterp]
  2255. } {0 .m1 {}}
  2256.  
  2257. test menu-27.1 {TkCreateMenuReferences - not there before} {
  2258.     catch {destroy .m1}
  2259.     list [catch {menu .m1} msg] $msg [destroy .m1]
  2260. } {0 .m1 {}}
  2261. test menu-27.2 {TkCreateMenuReferences - there already} {
  2262.     catch {destroy .m1}
  2263.     catch {destroy .m2}
  2264.     menu .m1
  2265.     .m1 add cascade -menu .m2
  2266.     list [catch {menu .m2} msg] $msg [destroy .m1 .m2]
  2267. } {0 .m2 {}}
  2268.  
  2269. test menu-28.1 {TkFindMenuReferences - not there} {
  2270.     catch {destroy .m1}
  2271.     . configure -menu ""
  2272.     menu .m1
  2273.     .m1 add cascade -menu .m2
  2274.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
  2275. } {0 {} {} {}}
  2276. test menu-29.1 {TkFindMenuReferences - there already} {
  2277.     catch {destroy .m1}
  2278.     catch {destroy .m2}
  2279.     . configure -menu ""
  2280.     menu .m1
  2281.     menu .m2
  2282.     .m1 add cascade -menu .m2
  2283.     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
  2284. } {0 {} {} {}}
  2285.  
  2286. test menu-30.1 {TkFreeMenuReferences - menuPtr} {
  2287.     catch {destroy .m1}
  2288.     menu .m1
  2289.     list [catch {destroy .m1} msg] $msg
  2290. } {0 {}}
  2291. test menu-30.2 {TkFreeMenuReferences - cascadePtr} {
  2292.     catch {destroy .m1}
  2293.     . configure -menu ""
  2294.     menu .m1
  2295.     .m1 add cascade -menu .m2
  2296.     list [catch {.m1 entryconfigure 1 -menu .m3} msg] $msg [destroy .m1]
  2297. } {0 {} {}}
  2298. test menu-30.3 {TkFreeMenuReferences - topLevelListPtr} {
  2299.     . configure -menu .m1
  2300.     list [catch {. configure -menu ""} msg] $msg
  2301. } {0 {}}
  2302. test menu-30.4 {TkFreeMenuReferences - not empty} {
  2303.     catch {destroy .m1}
  2304.     catch {destroy .m2}
  2305.     menu .m1
  2306.     .m1 add cascade -menu .m3
  2307.     menu .m2
  2308.     .m2 add cascade -menu .m3
  2309.     list [catch {.m2 entryconfigure 1 -menu ".foo"} msg] $msg [destroy .m1 .m2]
  2310. } {0 {} {}}
  2311.  
  2312. test menu-31.1 {DeleteMenuCloneEntries} {
  2313.     catch {destroy .m1}
  2314.     catch {destroy .m2}
  2315.     menu .m1
  2316.     .m1 add command -label foo
  2317.     .m1 clone .m2
  2318.     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
  2319. } {0 {} {}}
  2320. test menu-31.2 {DeleteMenuCloneEntries} {
  2321.     catch {destroy .m1}
  2322.     catch {destroy .m2}
  2323.     menu .m1
  2324.     .m1 add command -label one
  2325.     .m1 add command -label two
  2326.     .m1 add command -label three
  2327.     .m1 add command -label four
  2328.     .m1 clone .m2
  2329.     list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
  2330. } {0 {} {}}
  2331. test menu-31.3 {DeleteMenuCloneEntries} {
  2332.     catch {destroy .m1}
  2333.     catch {destroy .m2}
  2334.     menu .m1 -tearoff 0
  2335.     .m1 add command -label one
  2336.     .m1 add command -label two
  2337.     .m1 add command -label three
  2338.     .m1 add command -label four
  2339.     .m1 clone .m2
  2340.     .m2 configure -tearoff 1
  2341.     list [catch {.m1 delete 1 2} msg] $msg [destroy .m1]
  2342. } {0 {} {}}
  2343. test menu-31.4 {DeleteMenuCloneEntries} {
  2344.     catch {destroy .m1}
  2345.     catch {destroy .m2}
  2346.     menu .m1
  2347.     .m1 add command -label one
  2348.     .m1 add command -label two
  2349.     .m1 add command -label three
  2350.     .m1 add command -label four
  2351.     .m1 clone .m2
  2352.     .m2 configure -tearoff 0
  2353.     list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
  2354. } {0 {} {}}
  2355. test menu-31.5 {DeleteMenuCloneEntries} {
  2356.     catch {destroy .m1}
  2357.     catch {destroy .m2}
  2358.     menu .m1
  2359.     .m1 add command -label one
  2360.     .m1 add command -label two
  2361.     .m1 clone .m2
  2362.     .m1 activate one
  2363.     list [catch {.m1 delete one} msg] $msg [destroy .m1]
  2364. } {0 {} {}}
  2365.  
  2366. set l [interp hidden]
  2367. eval destroy [winfo children .]
  2368.  
  2369. test menu-32.1 {menu vs command hiding} {
  2370.     catch {destroy .m}
  2371.     menu .m
  2372.     interp hide {} .m
  2373.     destroy .m
  2374.     list [winfo children .] [interp hidden]
  2375. } [list {} $l]
  2376.  
  2377. # menu-34 MenuInit only called at boot time
  2378.  
  2379. deleteWindows
  2380.